home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / t_os / colorful / colorful.bas < prev    next >
BASIC Source File  |  1991-10-18  |  79KB  |  1,103 lines

  1. 5 CLEAR ,,1024,970000,22648
  2. 10 DEFINT A-Z:DIM CO%(2),CH%(2048),G%(48000),COL$(5),COL%(5),NOU$(4),NOU%(4),MIDL$(3),MID%(3),OCM$(3),OCM%(3),SCM$(4),LUM$(6),LUM%(6),G2%(256),G3%(256),GD%(8192),PAL&(255),IP%(7,3),PAL$(2),BY&(15),CMD&(10),GBAK%(368639)
  3. 15 DIM FILE_NAME$(256),RADBUT$(9),RETFLG(9),XY(20,4),WC(12) 'for File Dialog
  4. 16 DEF FNFF$(F$)=LEFT$(KLEFT$(F$,KINSTR(F$+"        .",".")-1)+SPACE$(8),8)+LEFT$(KMID$(F$,KINSTR(F$+"        .","."),4)+SPACE$(4),4):DEF FNPR$(A)=CHR$(A MOD 256)+CHR$(A \ 256)
  5. 17 OFFSET&=0:FDX=16:FDY=2:FDXM=FDX*8:FDYM=FDY*19:MAXCMD=12:CANCMD=9:BUTCMD=12:RADBUT=10:RCMD=0:WC$="*.*":TM$=SPACE$(8):FDM$=SPACE$(68):RIFLG=0:BASCOM=1
  6. 18 INFOR$=STRING$(200,0):DIR$=SPACE$(65):DRV_SET$=STRING$(26,0):FILENAME$=SPACE$(15):KAKUNO$=FILENAME$:PATH_ALL$=WC$:DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0):FOR A=0 TO 256:FILE_NAME$(A)=SPACE$(16):NEXT:FOR A=0 TO 9:RADBUT$(A)=SPACE$(60):NEXT
  7. 19 PATH$=SPACE$(255):DRIVE$=SPACE$(255):F_NAME$=SPACE$(255)
  8. 20 MCX=220:MCY=180:SCREEN@ 0:VERS$="1.45a":VDATE$="91/09/29":GOSUB *ABOUT_WRT:WAIT 150:OFA=&H3000:OFR=&H2000
  9. 30 MNDPF=1:SCSI=1     'mndpf=1:GT-4000/互換機  2:GT-6000
  10. 40 CLS:MABP=1:SAF=0:DI=3:PALM=0:FPAL=0:FCX=0:FCY=0:XLEN=1:YLEN=1:SCOM$=STRING$(64,0):PAR$=SCOM$:ON KEY(1) GOSUB *PALETTE_CHANGE:ON KEY(2) GOSUB *PF_PALETTE:KEY(1) ON:KEY(2) ON
  11. 50 FDPF$="A:\PREVIEW.PAT":FDSF$="A:\SCANDATA.TIF":DFD$="A:":DFF$="\GDATA.TIF":DPD$=DFD$:DPF$="\SCAN0001.SPF":MD$="A:\WORK"
  12. 60 ON ERROR GOTO 900:OPEN "I",#1,".\COLORFUL.ENV":MNDPF=ASC(INPUT$(1,1)):SCSI=ASC(INPUT$(1,1)):DUM=ASC(INPUT$(1,1)):FDPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):FDSF$=INPUT$(DUM,1):DFD$=INPUT$(1,1)+":":DUM=ASC(INPUT$(1,1)):DFF$=INPUT$(DUM,1):DPD$=DFD$
  13. 70 DUM=ASC(INPUT$(1,1)):DPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):MD$=INPUT$(DUM,1):CLOSE:ON ERROR GOTO 0
  14. 100 IF INKEY$="" THEN 1000
  15. 110 CONSOLE 5,1:LOCATE 20,0:PRINT "ColorfulStick 環境設定";
  16. 120 LOCATE 0,5:PRINT "使用機種 (1:GT-4000/FMSC-611G  2:GT-6000) ["+STR$(MNDPF)+"]";:MIN=1:MAX=2:YN=MNDPF:GOSUB *GETONEVAL:MNDPF=YN:CLS 1
  17. 130 LOCATE 0,5:PRINT "SCSI接続 (0:接続無し  1:接続あり) ["+STR$(SCSI)+"]";:MIN=0:MAX=1:YN=SCSI:GOSUB *GETONEVAL:SCSI=YN:CLS 1
  18. 140 LOCATE 0,6:M$="プレビューファイル ["+FDPF$+"]":YNM$=FDPF$:GOSUB *GETSTR:FDPF$=YNM$:CLS 3:IF RIGHT$(FDPF$,4)<>".PAT" THEN IF INSTR(FDPF$,".")=0 THEN FDPF$=FDPF$+".PAT" ELSE FDPF$=LEFT$(FDPF$,INSTR(FDPF$,"."))+"PAT"
  19. 150 LOCATE 0,6:M$="スキャンファイル ["+FDSF$+"]":YNM$=FDSF$:GOSUB *GETSTR:FDSF$=YNM$:CLS 3:IF RIGHT$(FDSF$,4)<>".TIF" THEN IF INSTR(FDSF$,".")=0 THEN FDSF$=FDSF$+".TIF" ELSE FDSF$=LEFT$(FDSF$,INSTR(FDSF$,"."))+"TIF"
  20. 160 'LOCATE 0,6:M$="デフォルトセーブファイル ["+DFD$+DFF$+"]":YNM$=DFD$+DFF$:GOSUB *GETSTR:IF INSTR(YNM$,":")=0 THEN DFF$=YNM$ ELSE YN=INSTR(YNM$,":"):DFD$=LEFT$(YNM$,YN):DFF$=RIGHT$(YNM$,LEN(YNM$)-YN)
  21. 170 'CLS 3:LOCATE 0,6:M$="デフォルトパラメータファイル ["+DPF$+"]":YNM$=DPF$:GOSUB *GETSTR:DPF$=YNM$:CLS 3
  22. 180 LOCATE 0,6:M$="モジュール格納パス ["+MD$+"]":YNM$=MD$:GOSUB *GETSTR:MD$=YNM$:WHILE (RIGHT$(MD$,1)="\"):MD$=LEFT$(MD$,LEN(MD$)-1):WEND:CLS 3
  23. 200 DPD$=DFD$:ON ERROR GOTO 950:OPEN "O",#1,".\COLORFUL.ENV"
  24. 210 PRINT #1,CHR$(MNDPF,SCSI);:PRINT #1,CHR$(LEN(FDPF$))+FDPF$;::PRINT #1,CHR$(LEN(FDSF$))+FDSF$;:PRINT #1,LEFT$(DFD$,1);:PRINT #1,CHR$(LEN(DFF$))+DFF$;
  25. 220 PRINT #1,CHR$(LEN(DPF$))+DPF$;:PRINT #1,CHR$(LEN(MD$))+MD$;:CLOSE:ON ERROR GOTO 850
  26. 230 A=0:SAVE@ FDPF$,G%
  27. 240 A=1:OPEN "O",#1,FDSF$:ON ERROR GOTO 880:PRINT #1,"DUMMYだよ";:CLOSE:ON ERROR GOTO 0:GOTO 1000
  28. 500 *GETONEVAL
  29. 510 YNX=POS(0)
  30. 520 YNM$=INPUT$(1):LOCATE 5,YNX:PRINT YNM$;:IF INSTR("0123456789"+CHR$(13),YNM$)=0 THEN BEEP:GOTO 520
  31. 530 IF YNM$=CHR$(13) THEN RETURN ELSE IF VAL(YNM$)<MIN OR VAL(YNM$)>MAX THEN BEEP:GOTO 520
  32. 540 YN=VAL(YNM$):RETURN
  33. 600 *GETSTR
  34. 610 CLS 3:LOCATE 0,6:PRINT M$:LINE INPUT YN$:IF YN$="" THEN RETURN
  35. 620 FOR A=1 TO LEN(YN$):A$=MID$(YN$,A,1):IF A$>="a" AND A$=<"z" THEN A$=CHR$(ASC(A$)-32):MID$(YN$,A,1)=A$
  36. 630 IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ.\0123456789$&#%^~!:_@",A$)=0 THEN A=500
  37. 640 NEXT:IF A>300 THEN BEEP:GOTO 610
  38. 650 YNM$=YN$:RETURN
  39. 700 *READ_REX:LOADM MD$+"\GTPOINT.REX",OFR:IF SCSI=0 THEN LOADM MD$+"\RS232C.REX",OFA ELSE LOADM MD$+"\SCSI.REX",OFA
  40. 710 LOADM MD$+"\BAS_LIB.REX",OFFSET&:RETURN
  41. 750 RESUME NEXT
  42. 850 IF A=0 THEN RESUME 240 ELSE ON ERROR GOTO 0:RESUME 1000
  43. 880 ON ERROR GOTO 0:CLS:PRINT USING "実行環境整備中に異常が発生しました。 erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:END
  44. 900 ON ERROR GOTO 0:CLOSE:RESUME 110
  45. 950 IF ERR=64 THEN KILL ".\COLORFUL.ENV":RESUME
  46. 960 ON ERROR GOTO 0:CLS:PRINT USING "環境ファイル書き込み中に異常が発生しました。 erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:RESUME 1000
  47. 1000 GOSUB *READ_REX:CALLM OFFSET&,7,VARPTR(INFOR$):ON ERROR GOTO 750:GOSUB *GETCD:ON ERROR GOTO 0 ':SHELL "A:":GOSUB *GETCD:ON ERROR GOTO 0
  48. 1010 A&=CALLM(OFA,VARPTR(CMD&(0))):IF A&<>0 AND SCSI=1 THEN BEEP:PRINT "SCSIがスキャナに未接続です":END ELSE FOR A=0 TO 10:CMD&(A)=CMD&(A)+OFA:NEXT
  49. 1020 GETH&=CMD&(0):PUTC&=CMD&(1):RCLOSE&=CMD&(2):RCMD&=CMD&(3):RGET1&=CMD&(4):RINIT&=CMD&(5):RPUT1&=CMD&(6):RSTAT2&=CMD&(7):RSTAT&=CMD&(8):RGET2&=CMD&(9):RPUT2&=CMD&(10):ERRC&=&H7FFFFFFF:PSCM=10:SCM=0:DSCM=SCM
  50. 1030 DEF FNF$(F)=RIGHT$("  "+STR$(F),3):DEF FNG$(G)=RIGHT$("  "+STR$(G),4):DEF FNM(X1,X2)=(X2-X1)\2+X1:DEF FND(N)=CVI(INPUT$(2,N)):DEF FNL$(A$)=CHR$(LEN(A$))+A$:DEF FND$(N)=INPUT$(ASC(INPUT$(1,N)),N):IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&
  51. 1040 RESTORE 1110:FOR A=0 TO 2:READ CO%(A):NEXT:GOSUB *SET_DPI:DIM DPI%(MNDP):FOR A=0 TO MNDP:READ DPI%(A):NEXT
  52. 1050 RESTORE *N_DPI:FOR A=0 TO 5:READ COL$(A),COL%(A):NEXT:FOR A=0 TO 4:READ NOU$(A),NOU%(A):NEXT:FOR A=0 TO 3:READ MIDL$(A),MID%(A):NEXT
  53. 1060 FOR A=0 TO 3:READ OCM$(A),OCM%(A):NEXT:FOR A=0 TO 3:READ SCM$(A):NEXT:FOR A=0 TO 6:READ LUM$(A),LUM%(A):NEXT:FOR A=0 TO 7:FOR B=0 TO 3:READ IP%(A,B):NEXT:NEXT:FOR A=0 TO 2:READ PAL$(A):NEXT:GOTO 1220
  54. 1070 *SET_DPI:ON MNDPF+1 GOTO 1080,1090,1100
  55. 1080 CLS:PRINT "指定された機種は対応してません。":END
  56. 1090 RESTORE *DPI1:MNDP=15:RETURN
  57. 1100 RESTORE *DPI2:MNDP=18:RETURN
  58. 1110 DATA 4,2,1
  59. 1120 *DPI1:DATA 50,72,80,90,100,120,144,150,160,180,200,240,300,320,360,400
  60. 1130 *DPI2:DATA 50,72,75,80,90,100,120,144,150,160,180,200,240,300,320,360,400,480,600
  61. 1140 *N_DPI:DATA "  モノクロ  ",0,モノクロ(赤),16,モノクロ(緑),32,モノクロ(青),48,カラー(面順),1,カラー(線順),2
  62. 1150 DATA " CRT(2値表示) ",1,"  CRT(中間調)  ",2," プリンタ(高密度) ",0," プリンタ(低密度) ",16,プリンタ(文字混在),32
  63. 1160 DATA 中間調A(硬調),0,中間調B(軟調),16,中間調C(網点),32,中間調処理なし,1
  64. 1170 DATA "Impact Dot Printer",16,"  熱転写プリンタ  ",32," Ink-Jet Printer  ",64,"CRTディスプレイ",128
  65. 1180 DATA "     16色モード   ","   32768色モード  "," 256色モード(2Bit)"," 256色モード(3Bit)"
  66. 1190 DATA "|        -3",253," |       -2",254,"  |      -1",255,"   |      0",0,"    |     1",1,"     |    2",2,"      |   3",3
  67. 1200 DATA 0,0,0,0 ,3,0,0,255 ,28,0,255,0 ,31,0,255,255 ,224,255,0,0 ,227,255,0,255 ,252,255,255,0 ,255,255,255,255
  68. 1210 DATA " モノクロ多階調モード "," パレット4096色モード ","パレット1677万色モード"
  69. 1220 ESC$=CHR$(27):STX$=CHR$(2):ACK$=CHR$(6):CAN$=CHR$(24):CONSOLE 0,25
  70. 1230 TY=1:CCOL=1:DFO=1:MID=0:SZOMX=100:SZOMY=100:R1=72:R2=72:OCM=128:NOU=1:LUM=0:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100):XST=0:YST=0:XEN=479:YEN=639:GOSUB *SCREEN_MODE:GOSUB *PALETTE_PALETTE:GOTO *MENU
  71. 1240 *READ:CLS:GOSUB *SCREEN_MODE:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
  72. 1250 IF XST+XEN>MAX-1 THEN PRINT USING "主走査方向領域(####)をはみ出しました。";MAX:RETURN
  73. 1260 IF YST+YEN>MAY-1 THEN PRINT USING "副走査方向領域(####)をはみ出しました。";MAY:RETURN
  74. 1270 IF PALM=0 THEN GOSUB *PALETTE_PALETTE ELSE GOSUB *PALETTE_SET
  75. 1280 PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(CCOL):GOSUB *SENDDATAC:SCOM$="D":IF PALM<>0 AND SCM<>1 THEN GOSUB *DEPTH_SET ELSE PAR$=CHR$(DFO)
  76. 1285 GOSUB *SENDDATA:SCOM$="B":PAR$=CHR$(MID):GOSUB *SENDDATA:SCOM$="H":PAR$=CHR$(SZOMX)+CHR$(SZOMY):GOSUB *SENDDATA
  77. 1290 SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA:SCOM$="R":PAR$=FNPR$(R1)+FNPR$(R2):GOSUB *SENDDATA
  78. 1300 SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST)+FNPR$(XEN+1)+FNPR$(YEN+1):IF (PALM=0 OR SCM=1) OR (PALM=1 AND SCM=2) THEN GOSUB *SENDDATA:A&=1
  79. 1310 IF CCOL=0 OR CCOL=32 THEN CCO0=0
  80. 1320 IF CCOL=16 THEN CCO0=1 ELSE IF CCOL=48 THEN CCO0=2
  81. 1330 IF CCOL=1 OR CCOL=2 THEN CCO0=0:CCO1=2 ELSE CCO1=CCO0
  82. 1340 MODE&=FPAL*16777216+PALM*65536+TY*256+SCM:GRAP&=VARPTR(CH%(0)):DUM=0:ON SCM+1 GOTO *SCAN_16,*SCAN_32768,*SCAN_256
  83. 1350 *SCAN_16:ON PALM GOTO 1870 '     データREAD
  84. 1360 IF TY=1 THEN *DIR_Y16
  85. 1370 *DIR_T16:IF CCOL=1 THEN 1390
  86. 1380 FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T16
  87. 1390 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
  88. 1400  *WAIT_T16
  89. 1410   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1450
  90. 1420   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  91. 1430   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
  92. 1440   PUT@ (0,L)-(XEN,L),CH%,OR,CO%(COL)
  93. 1450 NEXT:NEXT:CALLM RCLOSE&,PIT&
  94. 1460 RETURN
  95. 1470 *DIR_Y16:GOSUB *YEN_CHK_MABP:XEN1=(XEN+1)*MABP-1:LLEN=MSX-YEN*MABP:IF CCOL=1 THEN 1490
  96. 1480 FOR L=MSX TO LLEN STEP -1*MABP:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y16
  97. 1490 FOR COL=CCO0 TO CCO1:FOR L=MSX TO LLEN STEP -1*MABP
  98. 1500  *WAIT_Y16
  99. 1510   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:IF CCO0=CCO1 THEN LOCATE 40,24:COLOR 4:PRINT "スキャナからの読込を中止しました。";:COLOR 7:GOTO 1550 ELSE 1550
  100. 1520   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  101. 1530   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
  102. 1540   PUT@ (L-MABP+1,0)-(L,XEN1),CH%,OR,CO%(COL)
  103. 1550 NEXT:NEXT:CALLM RCLOSE&,PIT&
  104. 1560 RETURN
  105. 1570 *SCAN_32768
  106. 1580 IF TY=1 THEN *DIR_Y32
  107. 1590 *DIR_T32
  108. 1600 *DIR_T:IF CCOL=2 THEN FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T32
  109. 1610 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
  110. 1620  *WAIT_T32
  111. 1630   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1670
  112. 1640   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  113. 1650   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
  114. 1660   PUT@A (0,L)-(XEN,L),CH%,OR
  115. 1670 NEXT:NEXT:CALLM RCLOSE&,PIT&
  116. 1680 RETURN
  117. 1690 *DIR_Y32
  118. 1700 *DIR_Y:GOSUB *YEN_CHK:LLEN=MSX-YEN:IF CCOL=2 THEN FOR L=MSX TO LLEN STEP -1:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y32
  119. 1710 FOR COL=CCO0 TO CCO1:FOR L=MSX TO LLEN STEP -1
  120. 1720  *WAIT_Y32
  121. 1730   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:GOTO 1770
  122. 1740   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  123. 1750 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
  124. 1760 PUT@A (L,0)-(L,XEN),CH%,OR
  125. 1770 NEXT:NEXT:CALLM RCLOSE&,PIT&
  126. 1780 RETURN
  127. 1790 *SCAN_256:ON PALM GOTO 1850,1870,1880
  128. 1800 IF DFO=2 THEN 1830
  129. 1810 '
  130. 1820   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  131. 1830 '
  132. 1840   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  133. 1850 '
  134. 1860   IF TY=0 THEN *DIR_T ELSE *DIR_Y
  135. 1870 GOTO 1890
  136. 1880 '
  137. 1890 IF TY=1 THEN *DIR_YP ELSE IF (PALM<>1 OR SCM<>2) THEN CALLM RCLOSE&,PIT&:GOTO *DIR_TPM
  138. 1900 FOR L=0 TO YEN:FOR COL=0 TO 2
  139. 1910   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:NEXT:GOTO 1960
  140. 1920   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  141. 1930 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
  142. 1940 NEXT
  143. 1950   CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (0,L)-(XEN,L),CH%,PSET
  144. 1960 NEXT:CALLM RCLOSE&,PIT&:RETURN
  145. 1970 *DIR_YP:GOSUB *YEN_CHK:LLEN=MSX-YEN:IF (PALM<>1 OR SCM<>2) THEN CALLM RCLOSE&,PIT&:GOTO *DIR_YPM
  146. 1980 FOR L=MSX TO LLEN STEP -1:FOR COL=0 TO 2
  147. 1990   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:NEXT:GOTO 2040
  148. 2000   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  149. 2010 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
  150. 2020 NEXT
  151. 2030   CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (L,0)-(L,XEN),CH%,PSET
  152. 2040 NEXT:CALLM RCLOSE&,PIT&
  153. 2050 RETURN
  154. 2060 *DIR_TPM:GOSUB *PMCRED:Y=0:IF ((YEN+1) MOD (A+1)) THEN X=((YEN+1) MOD (A+1))-1 ELSE X=0
  155. 2065 WHILE Y<YEN:IF X=0 THEN X=Y+A:NA=A ELSE NA=X:X=Y+((YEN+1) MOD (A+1))-1
  156. 2070 GOSUB *SCROLL_CHECK_XOFY:PIT&=CALLM(RINIT&):SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST+Y)+FNPR$(XEN+1)+FNPR$((X-Y)+1):GOSUB *SENDDATA:A&=1
  157. 2080  FOR L=Y TO X:FOR COL=0 TO 2:LINE (0,456)-(63,471),PSET,0,BF:SYMBOL (0,456),"("+RIGHT$("    "+STR$(CINT(L/(YEN+1)*100)),4)+" %)",1,1,7
  158. 2090   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:Y=Y+512:NEXT:NEXT:CALLM RCLOSE&,PIT&:GOTO 2160
  159. 2100   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  160. 2110   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(GBAK%((L-Y)*LBC)),0,COL,1
  161. 2120  NEXT:NEXT:CALLM RCLOSE&,PIT&
  162. 2130  FOR L=Y TO X:IF INKEY$=ESC$ THEN L=YEN+1:Y=Y+512:GOTO 2150
  163. 2140   CALLM OFFSET&,9,&H14,VARPTR(GBAK%((L-Y)*LBC)),&H14,VARPTR(G%(0)),LBC*2:CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (0,L)-(XEN,L),CH%,PSET
  164. 2150  NEXT
  165. 2160 Y=Y+NA+1:NA=A:X=0:WEND
  166. 2170 X=0:Y=0:GOSUB *SCROLL_CHECK_XOFY:RETURN
  167. 2200 *DIR_YPM:GOSUB *PMCRED:LLEN=MSX-YEN:Y=MSX:IF ((YEN+1) MOD (A+1)) THEN X=((YEN+1) MOD (A+1))-1 ELSE X=0
  168. 2210 WHILE Y>LLEN:GOSUB *SCROLL_CHECK_YOFX:IF X=0 THEN X=Y-A:NA=A ELSE NA=X:X=Y-((YEN+1) MOD (A+1))+1
  169. 2220 PIT&=CALLM(RINIT&):SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST+(MSX-Y))+FNPR$(XEN+1)+FNPR$((Y-X)+1):GOSUB *SENDDATA:A&=1
  170. 2230  FOR L=Y TO X STEP -1:FOR COL=0 TO 2:LINE (0,456)-(63,471),PSET,0,BF:SYMBOL (0,456),"("+RIGHT$("    "+STR$(CINT((MSX-L)/(YEN+1)*100)),4)+" %)",1,1,7
  171. 2240   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:Y=Y-A*2-2:NEXT:NEXT:GOTO 2310
  172. 2250   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
  173. 2260   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(GBAK%((Y-L)*1024)),0,COL,1
  174. 2270  NEXT:NEXT:CALLM RCLOSE&,PIT&
  175. 2280  FOR L=Y TO X STEP -1:IF INKEY$=ESC$ THEN L=-1:Y=Y-A*2-2:GOTO 2300
  176. 2290   CALLM OFFSET&,9,&H14,VARPTR(GBAK%((Y-L)*1024)),&H14,VARPTR(G%(0)),2048:CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (L,0)-(L,XEN),CH%,PSET
  177. 2300  NEXT
  178. 2310 Y=Y-NA-1:X=0:NA=A:WEND
  179. 2320 X=0:Y=0:GOSUB *SCROLL_CHECK_YOFX:RETURN
  180. 2330 *SCROLL_CHECK_YOFX:FCX=X:FCY=Y:MMX=Y:MMY=0:GOSUB *SCROLL_CHECK:X=FCX:Y=FCY:RETURN
  181. 2340 *SCROLL_CHECK_XOFY:FCX=X:FCY=Y:MMX=0:MMY=X:GOSUB *SCROLL_CHECK:X=FCX:Y=FCY:RETURN
  182. 2350 *PMCRED:COLOR 7:LOCATE 0,19:PRINT "パレットモードスキャン実行中...":PRINT USING "読み取りサイズ #### × ####";XEN+1;YEN+1
  183. 2360 PRINT USING "カラーデプス # bits (#########,色)";DFB;8^DFB;
  184. 2370 LBC=(XEN+1)*2:A=CINT(327680/LBC+.49!)-1:RETURN
  185. 2380 *YEN_CHK:IF YEN>BSX THEN MSX=BDX ELSE MSX=BSX
  186. 2390 RETURN
  187. 2400 *YEN_CHK_MABP:IF YEN*MABP>BSX THEN MSX=BDX ELSE MSX=BSX
  188. 2410 RETURN
  189. 2500 *SENDDATA2C:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN ELSE *SENDDATA2
  190. 2510 *SENDDATAC:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN
  191. 2520 *SENDDATA:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR
  192. 2530 RETURN
  193. 2540 *SENDDATA2:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR3
  194. 2550 RETURN
  195. 2560 *SENDC:CALLM RPUT1&,ASC(CAN$):RETURN
  196. 2570 *SENDA:CALLM RPUT1&,ASC(ACK$):RETURN
  197. 2580 *SENDG:RETURN 'SCSI・RS共、REXルーチン内に内包
  198. 2590 *ERR:CLS:BEEP:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。":CALLM RCLOSE&,PIT&:RETURN 2600
  199. 2600 WAIT 400:RETURN
  200. 2610 *ERR2:CLS:PRINT "通信回線にエラーが発生しました。":CALLM RCLOSE&,PIT&::WAIT 400:RETURN
  201. 2620 *ERR3:BEEP:LOCATE 20,24:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。";:CALLM RCLOSE&,PIT&:FOR DUM=0 TO 32000:NEXT:LOCATE 20,24:PRINT SPC(40);:RETURN 2600
  202. 2630 *SCAN_PUT:CLS:OPALM=PALM:GOSUB *SCREEN_MODE:ON ERROR GOTO 2650:LOAD@ FDSF$:PS$=FDSF$:GOSUB *PALETTE_LOAD_IN:GOSUB *PALETTE_CHANGE
  203. 2640 PALM=OPALM:ON ERROR GOTO 0:GOSUB *PALETTE_INI:RETURN
  204. 2650 GOSUB *PALETTE_PALETTE:RESUME 2640
  205. 2660 *PREV_PUT:PSCM=4:SCREEN@ 0:PALETTE:MCX=220:MCY=180
  206. 2670 *PREV_PUT_IN:LOAD@ FDPF$,G%:CLS:PUT@ (60,0)-(639,423),G%,PSET,4:RETURN
  207. 2680 *MENU_WRT:GET@A (MCX,MCY)-(MCX+199,MCY+119),G%:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119:RETURN
  208. 2690 *MOUSE_GET:A=0:MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MOUSE(2,0)=0 THEN A$=INKEY$:IF A$=CHR$(13) OR A$=CHR$(24) THEN A=ASC(A$):RETURN ELSE *MOUSE_GET
  209. 2700 *MOUSE_CHK:WHILE MOUSE(6,0)=0:WEND:RETURN
  210. 3000 *MENU:IF PSCM<>1 THEN MCX=220:MCY=180 ELSE IF ZMFV=1 THEN MCX=156:MCY=68 ELSE MCX=60:MCY=60
  211. 3010 GET@A (MCX,MCY)-(MCX+199,MCY+119),G%
  212. 3020 *MENU_IN:GOSUB *PALETTE_INI:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:A&=FRE(4):FOR A=0 TO 128:A$=INKEY$:NEXT
  213. 3030 SYMBOL (MCX+4,MCY+2), "   仮読込       読込    ",1,1,4:SYMBOL (MCX+4,MCY+22)," パラメータ  モード設定 ",1,1,4:SYMBOL (MCX+4,MCY+42),"イメージ設定パレット設定",1,1,4:SYMBOL (MCX+4,MCY+62),"解像度&倍率   画面領域  ",1,1,4
  214. 3040 SYMBOL (MCX+3,MCY+82),"ファイル関連    終了    ",1,1,4
  215. 3050 LINE (MCX+1,MCY+101)-(MCX+198,MCY+118),PSET,3,BF,0:SYMBOL (MCX+4,MCY+102),"ColorfulStick Ver. "+VERS$,1,.5!,4:SYMBOL (MCX+4,MCY+110),"(C)1990-Aspergillus Valley",.9!,.5!,5
  216. 3060 LINE (MCX+1,MCY+20)-(MCX+198,MCY+20),PSET,7:LINE (MCX+1,MCY+40)-(MCX+198,MCY+40),PSET,7:LINE (MCX+1,MCY+60)-(MCX+198,MCY+60),PSET,7:LINE (MCX+1,MCY+80)-(MCX+198,MCY+80),PSET,7:LINE (MCX+1,MCY+100)-(MCX+198,MCY+100),PSET,7
  217. 3070 LINE (MCX+99,MCY+1)-(MCX+99,MCY+100),PSET,7
  218. 3080 MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119
  219. 3090 IF MOUSE (2,0) THEN A=MOUSE(6,0):GOSUB *MOUSE_CHK ELSE 3090
  220. 3100 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY
  221. 3110 IF MMY>100 THEN GOSUB *ABOUT:GOTO *MENU_IN
  222. 3120 CMD=(MMY) \ 20:CMD=CMD*2+((MMX) \ 99):MMX=(CMD MOD 2)*99+MCX:MMY=(CMD \ 2)*20+MCY:LINE (MMX+1,MMY+1)-(MMX+98,MMY+19),XOR,7,BF
  223. 3130 LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:ON CMD+1 GOTO *PREVIEW,*READ_S,*PARA,*MODE,*IMAGE,*PALETTE,*ZOOM,*AREA,*FILE,*END:GOTO *MENU_IN
  224. 3140 *NON_SAP:LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+4,MCY+22),"この機能は現在",1,1,4:SYMBOL (MCX+4,MCY+40),"サポートされていません。",1,1,4:WHILE MOUSE(6,0)=0:WEND:RETURN
  225. 3500 *ABOUT:GOSUB *ABOUT_WRT:GOSUB *MOUSE_CHK:RETURN
  226. 3510 *ABOUT_WRT:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:SYMBOL (MCX+3,MCY+17),"ColorfulStick",1,1,4,,,10:SYMBOL (MCX+3,MCY+48),"Version "+VERS$+" ("+VDATE$+")",1,1,5,,,5:SYMBOL (MCX+3,MCY+66),"Copyright 1990-",1,1,3,,,8
  227. 3520 SYMBOL (MCX+6,MCY+84),"Studio Aspergillus Valley",.85!,1,6,,,24:SYMBOL (MCX+44,MCY+102),"[ おくと-OcToh- ]",1,1,6,,,9:GET@A (MCX+3,MCY+17)-(MCX+110,MCY+34),GD%:FOR A=1 TO 10:Y=MCY+(17-A):PUT@A (MCX+3,Y)-(MCX+110,Y+17),GD%,PSET,1+A*.075!,1+A/10:NEXT
  228. 3530 CIRCLE (MCX+162,MCY+12),4,6,,,,F,,2:LINE (MCX+3,MCY+41)-(MCX+196,MCY+44),PSET,6,BF,2:RETURN
  229. 4000 *PREVIEW
  230. 4010 SYMBOL (MCX+4,MCY+22),"  仮読込を実行します。  ",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+132,MCY+99)-(MCX+165,MCY+119),PSET,5,B,&H5555
  231. 4020 SYMBOL (MCX+126,MCY+79),"まびき",1,.5!,4:SYMBOL (MCX+102,MCY+89),"なし  あ り",1,.5!,4:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
  232. 4030 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 4030 ELSE IF MMX<99 OR A=24 THEN *MENU_IN
  233. 4040 IF A=0 THEN MABP=SGN((MMX-100)\33)+1:GOSUB 4080:CCOL=(MMX\166)*OCOL
  234. 4050 TY=1:DFO=1:MID=0:SZOMX=100/MABP:SZOMY=100/MABP:R1=50:R2=50:NOU=1:XST=0:YST=0:XEN=207:YEN=289:SCM=0:LUM=0:OCM=128:FPAL=1:PALM=0:IF MABP<2 THEN XEN=423:YEN=579:FPAL=0
  235. 4060 MOUSE 5:GOSUB *READ:IF DUM<>0 THEN 4070 ELSE LOCATE 0,24:COLOR 4:PRINT "パターン読込中...";:GET@ (60,0)-(639,423),G%,4,5,6,7:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7:KILL FDPF$:SAVE@ FDPF$,G%
  236. 4070 MABP=1:GOSUB 4080:CLS 4:GOSUB *SCREEN_MODE:GOTO *MENU
  237. 4080 SWAP TY,OTY:SWAP CCOL,OCOL:SWAP DFO,ODFO:SWAP MID,OMID:SWAP SZOMX,OZMX:SWAP SZOMY,OZMY:SWAP R1,OOR1:SWAP R2,OOR2:SWAP NOU,ONOU:SWAP XST,OXST:SWAP YST,OYST:SWAP XEN,OXEN:SWAP YEN,OYEN:SWAP SCM,OSCM:SWAP LUM,OLUM:SWAP OCM,OOCM:SWAP FPAL,OFPAL
  238. 4090 SWAP PALM,OPALM:RETURN
  239. 4200 *READ_S:SYMBOL (MCX+4,MCY+22),"  読込を実行します。",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
  240. 4210 GOSUB *MOUSE_GET:IF A=13 THEN 4230 ELSE IF A=24 THEN *MENU_IN
  241. 4220 IF MMY<100 THEN 4210 ELSE IF MMX<99 THEN *MENU_IN
  242. 4230 MOUSE 5:GOSUB *PALETTE_UNDO:GOSUB *READ:IF DUM<>0 THEN *MENU ELSE IF PSCM<>2 THEN COLOR 4:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7
  243. 4240 KILL FDSF$:GOSUB *GSAVE_SUB:PS$=FDSF$:IF PSCM<>2 THEN CLS 4
  244. 4260 GOTO *MENU
  245. 4500 *PARA:RADBUT=2:RCMD=1:RWFLG=0:WC$="*.SPF":FDM$="操作を選んで、.SPFファイルの名前、格納位置を指定してください。":TM$="パラメータファイル":RADBUT$(0)=" ロード":RADBUT$(1)=" セーブ":RETFLG(0)=1:RETFLG(1)=1
  246. 4510 *PARA_LOOP:GOSUB *FILE_DIALOG:IF FDFLG<>2 THEN IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&
  247. 4520 IF FDFLG=0 THEN *MENU_IN ELSE IF FDFLG=2 THEN RWFLG=RCMD-1:RIFLG=2:GOTO *PARA_LOOP
  248. 4530 IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\"
  249. 4540 DPD$=DRIVE$:DPF$=F_NAME$:LSF=RCMD-1
  250. 4550 IF INSTR(DPF$,".")=0 THEN DPF$=LEFT$(DPF$,8)+".SPF":GOTO *GETFILE_END
  251. 4560 A=INSTR(DPF$,"."):IF LEN(DPF$)-A>3 OR A<2 THEN BEEP:FDFLG=0:GOTO *MENU_IN
  252. 4570 IF MID$(DPF$,A,4)<>".SPF" THEN DPF$=LEFT$(DPF$,A-1)+".SPF"
  253. 4580 *GETFILE_END:DPF$=PATH$+DPF$
  254. 4590 IF LSF=1 THEN 4650
  255. 4600 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "I",#1,DPD$+DPF$:ID$=INPUT$(4,1):IF LEFT$(ID$,3)<>"SPF" THEN 4630 ELSE TY=FND(1):CCOL=FND(1):DFO=FND(1):MID=FND(1):SZOMX=FND(1):SZOMY=FND(1):R1=FND(1):R2=FND(1):OCM=FND(1):NOU=FND(1):LUM=FND(1):FPAL=FND(1)
  256. 4610 XST=FND(1):YST=FND(1):XEN=FND(1):YEN=FND(1):PALM=FND(1):SCM=FND(1):DSCM=FND(1):SAF=FND(1):FCX=FND(1):FCY=FND(1):XLEN=FND(1):YLEN=FND(1):DFD$=INPUT$(2,1):DFF$=FND$(1):DPD$=INPUT$(2,1):DPF$=FND$(1)
  257. 4611 IF PALM<>0 THEN GOSUB *PARAPALL
  258. 4612 SCRLM=0:ZMFV=0:IF ID$="SPF1" THEN *GETPARA_SKIP
  259. 4613 SCRLM=ASC(INPUT$(1,1)):ZMFV=ASC(INPUT$(1,1))
  260. 4630 *GETPARA_SKIP:CLOSE:GOSUB *SCREEN_CALC2:ON ERROR GOTO 0:GOTO *MENU_IN
  261. 4640 ON ERROR GOTO 0:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,1,BF:LINE (MCX+99,MCY+99)-(MCX+199,MCY+119),XOR,1,BF,4:MOUSE 4,MCX,MCY,MCX+199,MCY+119:GOTO 4530
  262. 4650 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "O",#1,DPD$+DPF$:PRINT #1,"SPF2"+MKI$(TY)+MKI$(CCOL)+MKI$(DFO)+MKI$(MID)+MKI$(SZOMX)+MKI$(SZOMY)+MKI$(R1)+MKI$(R2)+MKI$(OCM)+MKI$(NOU)+MKI$(LUM)+MKI$(FPAL);
  263. 4660 PRINT #1,MKI$(XST)+MKI$(YST)+MKI$(XEN)+MKI$(YEN)+MKI$(PALM)+MKI$(SCM)+MKI$(DSCM)+MKI$(SAF)+MKI$(FCX)+MKI$(FCY)+MKI$(XLEN)+MKI$(YLEN)+DFD$+FNL$(DFF$)+DPD$+FNL$(DPF$);
  264. 4665 IF PALM<>0 THEN GOSUB *PARAPALS
  265. 4670 PRINT #1,CHR$(SCRLM)+CHR$(ZMFV);
  266. 4680 CLOSE:ON ERROR GOTO 0:GOTO *MENU_IN
  267. 4690 *GSAVE_SUB:IF PSCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ FDSF$,(0,0)-(1023,511),1 ELSE SAVE@ FDSF$,(0,0)-(511,255)
  268. 4700 RETURN
  269. 4800 *PARAPALS
  270. 4810 ON SCM+1 GOTO 4830,4820,4840
  271. 4820 RETURN
  272. 4830 FOR A=0 TO 15:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
  273. 4840 FOR A=0 TO 255:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
  274. 4900 *PARAPALL
  275. 4910 ON SCM+1 GOTO 4930,4920,4940
  276. 4920 RETURN
  277. 4930 GOSUB *INI256:FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:A&=16:RETURN
  278. 4940 FOR A=0 TO 255:PAL&(A)=CVL(INPUT$(4,1)):NEXT:A&=256:RETURN
  279. 5000 BEEP:IF ERR=64 THEN M$="同名のファイルがあります":GOSUB 5130:IF YN=0 THEN RESUME *MENU_IN ELSE KILL DPD$+DPF$:RESUME
  280. 5010 IF ERR=73 THEN M$="ディスクは書込禁止です":GOSUB 5130:IF YN=0 THEN RESUME *MENU_IN ELSE RESUME
  281. 5020 IF ERR=53 THEN M$="装置に異常が発生しました":GOSUB 5110:RESUME *MENU_IN
  282. 5025 IF ERR=54 THEN M$="データ数が足りません":GOSUB 5110:IF ERL>=4600 AND ERL<4630 THEN RESUME *GETPARA_SKIP ELSE RESUME NEXT
  283. 5030 IF ERR=55 THEN M$="ファイル記述に誤りがあります":GOSUB 5110:RESUME *MENU_IN
  284. 5040 IF ERR=60 THEN M$="入出力装置は使用不可です":GOSUB 5110:RESUME *MENU_IN
  285. 5050 IF ERR=63 THEN M$="ファイルが見つかりません":GOSUB 5110:RESUME *MENU_IN
  286. 5060 IF ERR=65 THEN M$="ディレクトリ領域がいっぱいです":GOSUB 5110:RESUME *MENU_IN
  287. 5070 IF ERR=67 THEN M$="空き領域がありません":GOSUB 5110:RESUME *MENU_IN
  288. 5080 IF ERR=71 THEN M$="ファイル構成が不正です":GOSUB 5110:RESUME *MENU_IN
  289. 5090 IF ERR=72 THEN M$="ディスク装置が使用不可です":GOSUB 5110:RESUME *MENU_IN
  290. 5100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 5110:RESUME *MENU_IN ELSE  M$="エラー ID="+FNF$(ERR)+" Line ="+FNG$(ERL):GOSUB 5110:CALLM RCLOSE&,PIT&:END
  291. 5110 GOSUB 5120:MOUSE 4,MCX+120,MCY+56,MCX+169,MCY+75:LINE (MCX+120,MCY+56)-(MCX+169,MCY+75),PSET,4,B:SYMBOL (MCX+122,MCY+58),"確認",1,1,4:GOSUB *MOUSE_GET:RETURN
  292. 5120 LINE (MCX+14,MCY+56)-(MCX+181,MCY+75),PSET,1,BF:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,2,BF,1:IF LEN(M$)<23 THEN SYMBOL (MCX+8,MCY+26),M$,1,1,4:RETURN ELSE SYMBOL (MCX+8,MCY+26),M$,.75!,1,4:RETURN
  293. 5130 GOSUB 5120:MOUSE 4,MCX+80,MCY+56,MCX+159,MCY+75:LINE (MCX+80,MCY+56)-(MCX+159,MCY+75),PSET,4,B:SYMBOL (MCX+84,MCY+58),"取消 続行",1,1,4:LINE (MCX+120,MCY+56)-(MCX+120,MCY+75),PSET,4:GOSUB *MOUSE_GET:IF A>0 THEN YN=SGN(24-A) ELSE YN=MMX\120
  294. 5140 RETURN
  295. 5150 *MODE:DFB=DFO:GOSUB *PREV_PUT:GOSUB *MENU_WRT:OSCM=SCM:SYMBOL (MCX+3,MCY+4),"取込映像上方",1,1,4:SYMBOL (MCX+39,MCY+41),"スクリーンモード",1,1,4:SYMBOL (MCX+38,MCY+101),"取消        実行",1,1,4:LINE (MCX+4,MCY+39)-(MCX+195,MCY+57),PSET,3,B
  296. 5160 LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+116,MCY+3)-(MCX+196,MCY+39),PSET,6,BF,4:SYMBOL (MCX+120,MCY+6),"♀",2,2,2:SYMBOL (MCX+190,MCY+6),"♀",2,2,2,3:LINE (MCX+156,MCY+4)-(MCX+156,MCY+38),PSET,1
  297. 5170 LINE (MCX+4,MCY+58)-(MCX+195,MCY+76),PSET,6,BF,4:LINE (MCX+2,MCY+3)-(MCX+115,MCY+21),PSET,3,B:LINE (MCX+20,MCY+58)-(MCX+179,MCY+76),PSET,6,BF,0:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7:LINE (MCX+115,MCY+3)-(MCX+197,MCY+39),PSET,3,B
  298. 5180 SYMBOL (MCX+5,MCY+74),"▲",1,1,2,1:SYMBOL (MCX+194,MCY+60),"▲",1,1,2,3:ODSCM=DSCM:OTY=TY:GOSUB 5280
  299. 5190 LINE (MCX+21,MCY+59)-(MCX+178,MCY+75),PSET,0,BF:SYMBOL (MCX+24,MCY+59),SCM$(DSCM),1,1,4:GOSUB *MOUSE_GET
  300. 5200 IF A>0 THEN IF A=24 THEN MMX=50:MMY=100 ELSE 5290
  301. 5210 IF MMY>98 THEN IF MMX<99 THEN DSCM=ODSCM:TY=OTY:GOTO *MENU_IN ELSE 5290
  302. 5220 IF (MMY<40 AND MMX<116) OR (MMY>39 AND MMY<58) OR MMY>76 THEN 5190
  303. 5230 IF MMY>57 AND MMX>20 AND MMX<179 THEN 5190
  304. 5240 IF MMY<40 THEN GOSUB 5280:IF MMX<156 THEN TY=1:GOSUB 5280:GOTO 5190 ELSE TY=0:GOSUB 5280:GOTO 5190
  305. 5250 IF MMX<21 THEN DSCM=DSCM-1:IF DSCM<0 THEN DSCM=3
  306. 5260 IF MMX>178 THEN DSCM=DSCM+1:IF DSCM>3 THEN DSCM=0
  307. 5270 GOTO 5190
  308. 5280 A=MCX+116+TY*41:LINE (A,MCY+4)-(A+39,MCY+38),XOR,1,BF:RETURN
  309. 5290 IF OTY<>TY THEN SWAP XEN,YEN:XEN=((XEN+1)\8)*8-1 ELSE 5330
  310. 5300 MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
  311. 5310 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 5310 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 5310
  312. 5320 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 5320 ELSE YEN=YEN-1:GOTO 5320
  313. 5330 IF DSCM=0 THEN DFO=1:SCM=DSCM
  314. 5340 IF DSCM=1 THEN DFO=5:SCM=DSCM:PALM=0
  315. 5350 IF DSCM=2 THEN DFO=2:SCM=DSCM
  316. 5360 IF DSCM=3 THEN DFO=3:SCM=2
  317. 5370 IF SCM<>OSCM THEN GOSUB *PALETTE_PALETTE_IN:PALM=0:FPAL=0:DFB=DFO:SCRLM=0
  318. 5380 GOSUB *SCREEN_CALC:IF TY THEN BDM=BDY:BDS=BDX ELSE BDM=BDX:BDS=BDY
  319. 5390 IF XEN>BDM THEN XEN=BDM
  320. 5400 IF YEN>BDS THEN YEN=BDS
  321. 5410 DFO=DFB:GOTO *MENU_IN
  322. 5420 *IMAGE:SYMBOL (MCX+3,MCY+4),"色指定",1,1,4:SYMBOL (MCX+3,MCY+24)," 明度",1,1,4:SYMBOL (MCX+3,MCY+44),"濃度補正",.75!,1,4:SYMBOL (MCX+3,MCY+64),"中間調",1,1,4:SYMBOL (MCX+3,MCY+84),"色補正",1,1,4:LINE (MCX+51,MCY+2)-(MCX+51,MCY+100),PSET,3
  323. 5430 FOR W=1 TO 4:A=MCY+2+20*W:LINE (MCX+2,A)-(MCX+198,A),PSET,3:NEXT:SYMBOL (MCX+38,MCY+105),"取消        実行",1,.8!,4:LINE (MCX+1,MCY+103)-(MCX+198,MCY+103),PSET,7:LINE (MCX+99,MCY+103)-(MCX+99,MCY+119),PSET,7
  324. 5440 FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+52,A)-(MCX+197,A+18),PSET,6,BF,4:NEXT:FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+62,A)-(MCX+187,A+18),PSET,6,BF,0:NEXT:LINE (MCX+2,MCY+2)-(MCX+198,MCY+102),PSET,3,B
  325. 5450 SYMBOL (MCX+54,MCY+99),"▲▲▲▲▲",1,.5!,2,1,,,4:SYMBOL (MCX+195,MCY+5),"▲▲▲▲▲",1,.5!,2,3,,,4
  326. 5460 CLP=0:FOR A=0 TO 5:IF COL%(A)=CCOL THEN CLP=A:NEXT ELSE NEXT
  327. 5470 LUMP=0:FOR A=0 TO 6:IF LUM%(A)=LUM THEN LUMP=A:NEXT ELSE NEXT
  328. 5480 NOUP=0:FOR A=0 TO 4:IF NOU%(A)=NOU THEN NOUP=A:NEXT ELSE NEXT
  329. 5490 MIDP=0:FOR A=0 TO 3:IF MID%(A)=MID THEN MIDP=A:NEXT ELSE NEXT
  330. 5500 OCMP=0:FOR A=0 TO 3:IF OCM%(A)=OCM THEN OCMP=A:NEXT ELSE NEXT
  331. 5510 CMD=0:PX!=1:PCX=16:M$=COL$(CLP):GOSUB 5640:CMD=1:PX!=1:PCX=0:M$=LUM$(LUMP):GOSUB 5640:CMD=2:PX!=.9!:PCX=0:M$=NOU$(NOUP):GOSUB 5640:CMD=3:PX!=1:PCX=8:M$=MIDL$(MIDP):GOSUB 5640:CMD=4:PX!=.9!:PCX=0:M$=OCM$(OCMP):GOSUB 5640
  332. 5520 GOSUB *MOUSE_GET:IF A>0 THEN IF A=13 THEN MMX=150:MMY=105 ELSE *MENU_IN
  333. 5530 IF MMY>103 THEN IF MMX>99 THEN CCOL=COL%(CLP):LUM=LUM%(LUMP):NOU=NOU%(NOUP):MID=MID%(MIDP):OCM=OCM%(OCMP):IF SCM=2 AND PALM=1 AND (CCOL=1 OR CCOL=2) THEN CCOL=0:GOTO *MENU_IN ELSE *MENU_IN ELSE *MENU_IN
  334. 5540 IF MMX<52 OR (MMX>62 AND MMX<187) THEN 5520
  335. 5550 IF MMY<22 THEN CMD=0:PX!=1:PCX=16:CMDP=CLP:CMDM=5:GOSUB 5610:CLP=CMDP:M$=COL$(CLP):GOTO 5600
  336. 5560 IF MMY<42 THEN CMD=1:PX!=1:PCX=0:CMDP=LUMP:CMDM=6:GOSUB 5610:LUMP=CMDP:M$=LUM$(LUMP):GOTO 5600
  337. 5570 IF MMY<62 THEN CMD=2:PX!=.9!:PCX=0:CMDP=NOUP:CMDM=4:GOSUB 5610:NOUP=CMDP:M$=NOU$(NOUP):GOTO 5600
  338. 5580 IF MMY<82 THEN CMD=3:PX!=1:PCX=8:CMDP=MIDP:CMDM=3:GOSUB 5610:MIDP=CMDP:M$=MIDL$(MIDP):GOTO 5600
  339. 5590 CMD=4:PX!=.9!:PCX=0:CMDP=OCMP:CMDM=3:GOSUB 5610:OCMP=CMDP:M$=OCM$(OCMP)
  340. 5600 GOSUB 5640:GOTO 5520
  341. 5610 IF MMX>98 THEN CMDP=CMDP+1:IF CMDP>CMDM THEN CMDP=CMDM
  342. 5620 IF MMX<99 THEN CMDP=CMDP-1:IF CMDP<0 THEN CMDP=0
  343. 5630 RETURN
  344. 5640 A=MCY+4+20*CMD:LINE (MCX+63,A)-(MCX+186,A+16),PSET,0,BF:SYMBOL (MCX+PCX+62,A),M$,PX!,1,4:RETURN
  345. 5650 GOTO 5650
  346. 5660 *PALETTE:IF SCM=1 THEN LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+20,MCY+22),"現在の画面モードでは",1,1,4:SYMBOL (MCX+20,MCY+40),"設定できません",1,1,4:GOSUB *MOUSE_GET:GOTO *MENU_IN
  347. 5670 GOSUB *SCREEN_MODE:GOSUB *PREV_PUT_IN:LINE (60,0)-(639,423),PSET,7,B:LINE (13,435)-(226,454),PSET,6,BF,4:LINE (229,435)-(402,454),PSET,6,BF,4:LINE (30,435)-(209,454),PSET,6,BF,0:LINE (246,435)-(385,454),PSET,6,BF,0:LOCATE 52,23:COLOR (SCM+1)*2
  348. 5680 PRINT "メニュー  取り込み  初期化";:LINE (412,435)-(483,454),XOR,3,BF,4:LINE (492,435)-(563,454),XOR,3,BF,4:LINE (572,435)-(627,454),XOR,3,BF,4:MOUSE 0:MOUSE 1,320,240,1:GOSUB 6280:COLOR 4:LOCATE 31,23:PRINT "固定パレット";:COLOR 6:LOCATE 2,24
  349. 5690 PRINT "Palette Mode";:LINE (13,455)-(115,472),XOR,2,BF,1:LINE (115,455)-(146,472),PSET,2,BF,0:SYMBOL (14,452),"▲",1,1,2,1:SYMBOL (210,452),"▼",1,1,2,1:SYMBOL (230,452),"▲",1,1,2,1:SYMBOL (386,452),"▼",1,1,2,1:COLOR 6:GOSUB *PALETTE_CHANGE
  350. 5700 IF SCM=2 THEN *PALETTE_256
  351. 5710 *PALETTE_16:MPAL=16:FOR A=0 TO 15:LINE (10,A*19+10)-(49,A*19+30),PSET,7,BF,%A:NEXT:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=16:GOSUB 6130
  352. 5720 GOSUB 5850:IF CMD=1 THEN FPAL=PAL2:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:CLS 4:GOSUB 6130:FPAL=PAL2:DFO=PALM*3+1:IF DFO=4 THEN CCOL=2:GOTO *MENU ELSE *MENU
  353. 5730 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5720 ELSE LGP2=16:IF PAL2=16 THEN BEEP:GOTO 5720 ELSE LGP=8:LGP3=4:LGP4=16-PAL2:GOSUB 5780:PALM=1:GOSUB 6080:GOTO 5720
  354. 5740 *PALETTE_256:MPAL=256:MOUSE 1,,,0:FOR A=0 TO 15:FOR B=0 TO 15:LINE (B*3,A*3)-(B*3+2,A*3+2),PSET,%(A*16+B),BF:NEXT:NEXT:MOUSE 1,,,1:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=64:GOSUB 6130
  355. 5750 GOSUB 5850:IF CMD<>1 THEN 5770 ELSE PALM=PAL1+1:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOSUB 6130:IF PAL1>=0 THEN DFO=8-(PAL1 MOD 2)*4 ELSE DFO=DSCM
  356. 5760 IF PAL1<>0 THEN FPAL=0:CCOL=2:GOTO *MENU ELSE FPAL=PAL2 MOD 3:GOSUB *PALETTE_SET:IF CCOL<3 THEN CCOL=0:GOTO *MENU ELSE *MENU
  357. 5770 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5750 ELSE LGP2=64:IF PAL1<1 OR PAL2=256 THEN BEEP:GOTO 5750 ELSE LGP=32*PAL1:LGP3=4*PAL1:LGP4=256-PAL2:GOSUB 5780:GOTO 5750
  358. 5780 LINE (148,455)-(331,472),PSET,0,BF:LOCATE 20,24:PRINT "スキャナ読み込み中…   ";:PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(2):GOSUB *SENDDATA2C:SCOM$="D":SWAP LGP3,DFO:GOSUB *DEPTH_SET:SWAP LGP3,DFO:GOSUB *SENDDATA2
  359. 5790 SCOM$="H":PAR$=CHR$(100,100):GOSUB *SENDDATA2:SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA2:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA2:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA2:SCOM$="R":PAR$=CHR$(50,0,50,0):GOSUB *SENDDATA2
  360. 5800 SCOM$="A":PAR$=CHR$(PALY MOD 256,PALY \ 256,PALX MOD 256,PALX \ 256,PALL,0,PALL,0):GOSUB *SENDDATA2:A&=1
  361. 5810 FOR L=0 TO LGP2-1:FOR COL=0 TO 2
  362. 5820 A&=CALLM(GETH&,VARPTR(GD%(0))+LGP*COL,A&):IF A&=ERRC& THEN *ERR2
  363. 5830 NEXT:CALLM OFR,LGP,0,VARPTR(GD%(0)),VARPTR(G%(L*2*LGP2)):NEXT:CALLM RCLOSE&,PIT&:LOCATE 20,24:PRINT "パレットデータ作成中… ";:A&=CALLM(OFR,LGP,LGP4,0,VARPTR(G%(0)),VARPTR(PAL&(0))):GOSUB *PALETTE_CHANGE
  364. 5840 LOCATE 20,24:PRINT "定義済パレット数 :";FNF$(MPAL-A&);" ";:LINE (148,455)-(331,472),PSET,6,B:RETURN
  365. 5850 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX<640-PALX AND MMY=>PALY AND MMX>639-PALX-PALL AND MMY<PALY+PALL THEN GOSUB 6270:GOTO 5850
  366. 5860 WHILE MOUSE(6,0)=0:A=MOUSE(2,1):WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMY<435 THEN 5930 ELSE IF MMY>454 THEN 5850 ELSE IF MMX>411 THEN 6140
  367. 5870 IF MMX<31 AND SCM=2 THEN PAL1=PAL1-1:IF PAL1<0 THEN PAL1=2
  368. 5880 IF MMX>208 AND MMX<227 AND SCM=2 THEN PAL1=PAL1+1:IF PAL1>2 THEN PAL1=0
  369. 5890 IF MMX>228 AND MMX<247 THEN PAL2=PAL2-1+A*3.5!:IF PAL2<0 THEN IF A THEN PAL2=0 ELSE PAL2=MPAL
  370. 5900 IF MMX>384 AND MMX<403 THEN PAL2=PAL2+1-A*3.5!:IF PAL2>MPAL THEN IF A THEN PAL2=MPAL ELSE PAL2=0
  371. 5910 IF MMX>246 AND MMX<385 THEN PAL2=MPAL-A&
  372. 5920 GOSUB 6100:GOSUB 6080:GOTO 5850
  373. 5930 IF SCM=2 THEN 5850 ELSE IF MMX>9 AND MMX<49 AND MMY>9 AND MMY<314 THEN COLOR 7 ELSE 5850
  374. 5940 PCY=(MMY-10)\19:GET@A (50,PCY*19+5)-(259,PCY*19+124),G%:LINE (76,PCY*19+5)-(259,PCY*19+124),PSET,7,BF,1:CONNECT (76,PCY*19+12)-(50,PCY*19+17)-(76,PCY*19+22),7,PSET,F,1:LOCATE 30,PCY+1:PRINT "□":PRINT SPC(10);"パレット修正"
  375. 5950 PRINT SPC(10);"G <";SPC(16);">":PRINT SPC(10);"R <";SPC(16);">":PRINT SPC(10);"B <";SPC(16);">":FOR A=0 TO 2:GOSUB 6040:NEXT:FOR A=3 TO 5:LINE (76,(PCY+A)*19-2)-(259,(PCY+A)*19+17),PSET,7,B:LINE(89,(PCY+A)*19-2)-(111,(PCY+A)*19+17),PSET,7,B
  376. 5960 LINE (239,(PCY+A)*19-2)-(239,(PCY+A)*19+17),PSET,7,B:NEXT:LINE (240,PCY*19+19)-(254,PCY*19+34),PSET,7:LINE (254,PCY*19+19)-(240,PCY*19+34),PSET,7:LINE (80,PCY*19+9)-(119,PCY*19+28),PSET,7,BF,%PCY:MOUSE 4,76,PCY*19+5,259,PCY*19+124
  377. 5970 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>239 AND MMY>PCY*19+18 AND MMX<255 AND MMY<PCY*19+35 THEN WHILE MOUSE(6,0)=0:WEND:PUT@A (50,PCY*19+5)-(259,PCY*19+124),G%:GOSUB 6280:FOR A=0 TO 5:LOCATE 0,PCY+A:PRINT SPC(40);:NEXT:GOTO 5850
  378. 5980 IF MMX<76 OR MMX>259 OR MMY<(PCY+3)*19-2 OR MMY>(PCY+5)*19+17 THEN 5970 ELSE A=(MMY-PCY*19+2)\19-3:IF MMX<111 OR MMX>239 THEN GOSUB 6000:GOTO 5970
  379. 5990 B=(MMX-111)\8:GOSUB 6010:GOTO 5970
  380. 6000 GOSUB 6050:WHILE MOUSE(6,0)=0:WEND:BB=B:B=B+SGN(MMX-150):IF B>15 OR B<0 THEN B=BB
  381. 6010 ON A GOTO 6020,6030:PAL&(PCY)=(PAL&(PCY) AND 65535)+B*1048576:GOTO 6040
  382. 6020 PAL&(PCY)=(PAL&(PCY) AND 16711935)+B*4096:GOTO 6040
  383. 6030 PAL&(PCY)=(PAL&(PCY) AND 16776960)+B*16
  384. 6040 PALETTE PCY,[(PAL&(PCY) AND 16711680)\65536,(PAL&(PCY) AND 65280)\256,PAL&(PCY) AND 255]
  385. 6050 ON A GOTO 6060,6070:B=(PAL&(PCY) AND 16711680)\1048576:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+3:PRINT A$:RETURN
  386. 6060 B=(PAL&(PCY) AND 65280)\4096:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+4:PRINT A$:RETURN
  387. 6070 B=(PAL&(PCY) AND 255)\16:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+5:PRINT A$:RETURN
  388. 6080 LOCATE 15,24:IF (SCM=2 AND PAL1<0) OR (SCM=0 AND PALM=0) THEN PRINT "OFF"; ELSE PRINT "ON ";
  389. 6090 LINE (13,455)-(146,472),PSET,2,B:RETURN
  390. 6100 LOCATE 43,23:COLOR 4:GOSUB 6110:LINE (246,454)-(385,454),PSET,6:LOCATE 4,23:IF SCM=0 OR PAL1=-1 THEN PRINT SPC(22);:LINE (30,454)-(209,454),PSET,6,BF,%7:COLOR 6:RETURN ELSE PRINT PAL$(PAL1);:COLOR 6:LINE (30,454)-(209,454),PSET,6:RETURN
  391. 6110 IF PAL1=0 AND SCM=2 THEN IF (PAL2 MOD 3)=0 THEN PRINT " 無し";:RETURN ELSE PRINT FNF$((PAL2 MOD 3)*8)+"色";:RETURN
  392. 6120 IF PAL2=0 THEN PRINT " 無し";:RETURN ELSE PRINT FNF$(PAL2)+"色";:RETURN
  393. 6130 LINE (639-PALX,PALY)-(640-PALX-PALL,PALY+PALL-1),XOR,7,B:RETURN
  394. 6140 CMD=0:IF MMX>411 AND MMX<484 THEN CMD=1 ELSE IF MMX>491 AND MMX<564 THEN CMD=2 ELSE IF MMX>571 AND MMX<628 THEN CMD=3
  395. 6150 IF CMD=0 THEN 5850 ELSE PCX=CMD*80+280:IF CMD=3 THEN 6180 ELSE GET@A (PCX,416)-(PCX+109,436),G%:LINE (PCX,416)-(PCX+109,436),PSET,3,BF,4:SYMBOL (PCX+12,418),"取消   実行",1,1,2,,,5:LINE (PCX+56,416)-(PCX+56,436),PSET,3
  396. 6160 MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,416,PCX+109,436:GOSUB *MOUSE_GET:MMX=MMX+MCX:IF A>0 THEN MMX=60*SGN(24-A)+PCX
  397. 6170 GOSUB 6280:PUT@A (PCX,416)-(PCX+109,436),G%,PSET:MMX=MMX-PCX:IF MMX<56 THEN 5850 ELSE RETURN
  398. 6180 GET@A (PCX,332)-(PCX+109,437),G%:LINE (PCX,332)-(PCX+109,437),PSET,3,BF,4:RESTORE 6260:FOR A=0 TO 5:READ M$:IF PSCM=0 AND A=4 THEN M$="――――――"
  399. 6190 SYMBOL (PCX+4,334+17*A),M$,1,1,2,,,5:NEXT:MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,334,PCX+109,435:CMD=9
  400. 6200 MMY=MOUSE(1):IF INKEY$=CHR$(24) THEN 6253 ELSE OCMD=CMD:CMD=(MMY-334)\17
  401. 6210 IF CMD<>OCMD THEN LINE (PCX,334+17*OCMD)-(PCX+109,349+17*OCMD),XOR,4,BF:LINE (PCX,334+17*CMD)-(PCX+109,349+17*CMD),XOR,4,BF
  402. 6220 IF MOUSE(2,0)=0 THEN 6200 ELSE WHILE MOUSE(6,0)=0:WEND:IF CMD=5 THEN 6253 ELSE IF CMD=4 THEN IF PSCM=0 THEN 6253 ELSE PAL1=0
  403. 6230 GOSUB *PALETTE_FIX:IF CMD=0 THEN IF PSCM=0 THEN PALM=0 ELSE PAL1=-1
  404. 6240 IF CMD>1 AND CMD<4 THEN IF PSCM=0 THEN PALM=1 ELSE IF PAL1<2 THEN PAL1=2
  405. 6250 PUT@A (PCX,332)-(PCX+109,437),G%,PSET:GOSUB 6280:CMD=3:RETURN
  406. 6253 IF PSCM=0 THEN A&=16 ELSE IF PSCM=2 THEN A&=256
  407. 6255 GOTO 6250
  408. 6260 DATA "Towns System","MaskT_Paint","Rainbow","ColofulStick","GrayScale"," 取 消 "
  409. 6270 GOSUB 6130:MMX=639-PALX:MMY=PALY+PALL-1:MOUSE 1,MMX,MMY,1:MOUSE 4,59+PALL,PALL-1,639,423:WHILE MOUSE(6,0)=0:PALX=639-MOUSE(0):PALY=MOUSE(1)-PALL+1:GOSUB 6130:GOSUB 6130:WEND:GOSUB 6130
  410. 6280 MOUSE 4,0,0,639,454:RETURN
  411. 6290 *ZOOM:SYMBOL (MCX+3,MCY+4),"解像度",1,1,4:SYMBOL (MCX+3,MCY+38),"倍率",1,1,4:SYMBOL (MCX+52,MCY+4),"主",1,1,3:SYMBOL (MCX+52,MCY+21),"副",1,1,3:SYMBOL (MCX+52,MCY+38),"主",1,1,3:SYMBOL (MCX+52,MCY+55),"副",1,1,3
  412. 6300 LINE (MCX+74,MCY+2)-(MCX+189,MCY+71),PSET,3,BF,4:LINE (MCX+90,MCY+2)-(MCX+173,MCY+71),PSET,3,BF,6:LINE (MCX+106,MCY+2)-(MCX+157,MCY+71),PSET,3,BF,0:LINE (MCX+90,MCY+20)-(MCX+173,MCY+54),PSET,3,B:LINE (MCX+74,MCY+37)-(MCX+189,MCY+37),PSET,3:GOSUB 6580
  413. 6310 SYMBOL (MCX+77,MCY+68),"▲▲",2,.7!,2,1,,,2:SYMBOL (MCX+186,MCY+5),"▲▲",2,.7!,2,3,,,2:SYMBOL (MCX+93,MCY+69),"▲▲▲▲",1,.7!,2,1,,,1:SYMBOL (MCX+170,MCY+4),"▲▲▲▲",1,.7!,2,3,,,1:SYMBOL (MCX+3,MCY+76),"↑主        %",1,1,4,,,8
  414. 6320 SYMBOL (MCX+3,MCY+94),"←副",1,1,4,,,8:LINE (MCX,MCY+73)-(MCX+199,MCY+73),PSET,7:LINE (MCX+90,MCY+73)-(MCX+90,MCY+119),PSET,7:SYMBOL (MCX+92,MCY+91),"Zoom",.75!,.5!,5,,,8:SYMBOL (MCX+4,MCY+110),"Screen",.75!,.5!,5,,,8
  415. 6330 OZMX=SZOMX:OZMY=SZOMY:SYMBOL (MCX+102,MCY+101),"取消   実行",1,1,4:LINE (MCX+90,MCY+99)-(MCX+199,MCY+99),PSET,7:LINE (MCX+145,MCY+99)-(MCX+145,MCY+119),PSET,7:SYMBOL (MCX+124,MCY+75),"M     S",.8!,.5!,5:MOUSE 1,MCX+100,MCY+60,1
  416. 6340 GOSUB 6520:GOSUB 6530:GOSUB 6540:GOSUB 6550:GOSUB 6560:A=0:I=0
  417. 6350 IF MOUSE(2,0)=0 THEN I$=INKEY$:IF MOUSE(2,1) THEN SZOMX=OZMX:SZOMY=OZMY:GOTO 6340 ELSE IF I$=CHR$(13) OR I$=CHR$(24) THEN I=ASC(I$):MMX=100+50*SGN(24-I):GOTO 6510 ELSE 6350
  418. 6360 IF MOUSE(6,0)=0 THEN A=A+1 ELSE A=0
  419. 6370 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MMY>72 THEN IF MMY<99 OR MMX<90 THEN A=0:GOTO 6350 ELSE 6510
  420. 6380 IF MMX<74 OR MMX>189 OR (MMX>106 AND MMX<157) THEN A=0:GOTO 6350
  421. 6390 ADP=SGN(MMX-120):IF A>10 THEN ADP=ADP*10
  422. 6400 IF MMY<37 THEN 6410 ELSE 6460
  423. 6410 IF MMX>90 AND MMX<173 THEN IF MMY>20 THEN GOSUB 6440:FOR W=0 TO 1000:NEXT:GOTO 6350 ELSE 6420 ELSE GOSUB 6440
  424. 6420 SR1P=R1P:R1P=R1P+SGN(ADP):IF R1P<0 OR R1P>MNDP THEN R1P=SR1P
  425. 6430 GOSUB 6520:FOR W=0 TO 1000:NEXT:GOTO 6350
  426. 6440 SR2P=R2P:R2P=R2P+SGN(ADP):IF R2P<0 OR R2P>MNDP THEN R2P=SR2P
  427. 6450 GOSUB 6530:RETURN
  428. 6460 IF MMX>90 AND MMX<173 THEN IF MMY>54 THEN GOSUB 6490:GOSUB 6560:GOTO 6350 ELSE 6470 ELSE GOSUB 6490
  429. 6470 SZOMX=SZOMX+ADP:IF SZOMX<50 THEN SZOMX=50 ELSE IF SZOMX>200 THEN SZOMX=200
  430. 6480 GOSUB 6540:GOSUB 6560:GOTO 6350
  431. 6490 SZOMY=SZOMY+ADP:IF SZOMY<50 THEN SZOMY=50 ELSE IF SZOMY>200 THEN SZOMY=200
  432. 6500 GOSUB 6550:RETURN
  433. 6510 IF MMX<145 THEN SZOMX=OZMX:SZOMY=OZMY:GOTO *MENU_IN ELSE R1=DPI%(R1P):R2=DPI%(R2P):GOTO *MENU_IN
  434. 6520 LINE (MCX+120,MCY+3)-(MCX+143,MCY+18),PSET,0,BF:SYMBOL (MCX+120,MCY+3),FNF$(DPI%(R1P)),1,1,4:GOSUB 6560:RETURN
  435. 6530 LINE (MCX+120,MCY+21)-(MCX+143,MCY+35),PSET,0,BF:SYMBOL (MCX+120,MCY+21),FNF$(DPI%(R2P)),1,1,4:GOSUB 6560:RETURN
  436. 6540 LINE (MCX+120,MCY+38)-(MCX+143,MCY+53),PSET,0,BF:SYMBOL (MCX+120,MCY+38),FNF$(SZOMX),1,1,4:RETURN
  437. 6550 LINE (MCX+120,MCY+55)-(MCX+143,MCY+70),PSET,0,BF:SYMBOL (MCX+120,MCY+55),FNF$(SZOMY),1,1,4:RETURN
  438. 6560 LINE (MCX+46,MCY+76)-(MCX+86,MCY+116),PSET,1,BF:RHI!=(SZOMY/SZOMX)*(DPI%(R2P)/DPI%(R1P)):IF RHI!>1 THEN RLN!=20/RHI! ELSE RLN!=20
  439. 6570 CIRCLE (MCX+66,MCY+96),RLN!,4,RHI!:LINE (MCX+128,MCY+83)-(MCX+197,MCY+98),PSET,1,BF:SYMBOL (MCX+130,MCY+83),FNF$(INT(SZOMX/OZMX*100))+"  "+FNF$(INT(SZOMY/OZMY*100)),1,1,4:RETURN
  440. 6580 R1P=0:FOR A=0 TO MNDP:IF DPI%(A)=R1 THEN R1P=A:NEXT ELSE NEXT
  441. 6590 R2P=0:FOR A=0 TO MNDP:IF DPI%(A)=R2 THEN R2P=A:NEXT ELSE NEXT
  442. 6600 RETURN
  443. 6610 *AREA:GOSUB *PREV_PUT:LINE (60,0)-(639,423),PSET,7,B:LINE (504,428)-(599,449),PSET,%8,BF,%7:SYMBOL (504,430)," 取消  実行 ",1,1,4:LINE (551,428)-(551,449),PSET,%8
  444. 6620 LINE (0,0)-(58,423),PSET,%7,BF,%1:LINE (6,10)-(52,18),PSET,7,B:SYMBOL (4,30),"スキャナ読取",.75!,1,5:SYMBOL (4,46),"可能領域",.75!,1,5:LINE (6,70)-(52,78),PSET,7,B,&H3333:SYMBOL (4,90),"読取",.75!,1,5:SYMBOL (4,106),"指定領域",.75!,1,5:COLOR 6
  445. 6630 RSM!=(100/SZOMX)*(50/R1):RSS!=(100/SZOMY)*(50/R2):LINE (6,435)-(482,454),PSET,3,BF,%1:SYMBOL (36,76),"xor",.75!,1,4,,,,1:OXST=XST:OYST=YST:OXEN=XEN:OYEN=YEN:IF TY THEN DI$="  ↑":BDM=BDY+1:BDS=BDX+1 ELSE DI$="  →":BDM=BDX+1:BDS=BDY+1
  446. 6640 LINE (6,457)-(625,476),PSET,2,BF,%1:SYMBOL (16,459),"解像度(dpi)  主: "+FNF$(R1)+" 副: "+FNF$(R2)+"   倍率(%)  主: "+FNF$(SZOMX)+" 副: "+FNF$(SZOMY)+"   映像上方:"+DI$,1,1,5:MAX=8*(INT((8.56!*R1*SZOMX/100)/8))-1:MAY=INT(11.6!*R2*SZOMY/100)-1
  447. 6650 A&=FRE(4):IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 6650 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6650
  448. 6660 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 6660 ELSE YEN=YEN-1:GOTO 6660
  449. 6670 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1:ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS
  450. 6680 IF ARM>423 THEN IF XST>0 THEN XST=XST-1:GOTO 6670 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6670
  451. 6690 IF ASS<60 THEN IF YST>0 THEN YST=YST-1:GOTO 6670 ELSE YEN=YEN-1:GOTO 6670
  452. 6700 GOSUB 7010
  453. 6710 GOSUB 7250:MOUSE 4,60,0,639,449:MOUSE 1,FNM(ARS,ASS),FNM(ASM,ARM),1:GOTO 6730
  454. 6720 IF MOUSE(2,1) THEN GOSUB 7240:WHILE MOUSE(6,1)=0:WEND:XST=OOXST:YST=OOYST:XEN=OOXEN:YEN=OOYEN:ASS=OASS:ASM=OASM:ARS=OARS:ARM=OARM:GOSUB 7250
  455. 6730 I=0:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B,&H0F0F:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:IF MOUSE(2,0) THEN A=MOUSE(6,0):OOXST=XST:OOYST=YST:OOXEN=XEN:OOYEN=YEN:OASS=ASS:OASM=ASM:OARS=ARS:OARM=ARM ELSE I$=INKEY$:IF I$="" THEN 6720 ELSE I=ASC(I$)
  456. 6740 GOSUB 7240:IF I>0 THEN MMX=510+50*SGN(24-I):GOTO 7220
  457. 6750 MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>504 AND MMY>428 AND MMX<599 AND MMY<449 THEN 7220 ELSE IF MMX>ASS+DI OR MMX<ARS-DI OR MMY<ASM-DI OR MMY>ARM+DI THEN 6720 ELSE CMD=0
  458. 6760 IF MMX>ASS-DI THEN CMD=1:GOTO 6780
  459. 6770 IF MMX<ARS+DI THEN CMD=4
  460. 6780 IF MMY<ASM+DI THEN CMD=CMD+8:GOTO 6800
  461. 6790 IF MMY>ARM-DI THEN CMD=CMD+2
  462. 6800 IF CMD=0 THEN 7160 ELSE LNX=60:LNY=0:CPX=639:CPY=423
  463. 6810 IF CMD AND 1 THEN MMX=ASS:LNX=ARS:CPX=639:IF BDS*RSS!<CPX-LNX THEN CPX=BDS*RSS!+LNX
  464. 6820 IF CMD AND 2 THEN MMY=ARM:LNY=ASM:CPY=423:IF BDM*RSM!<CPY-LNY THEN CPY=BDM*RSM!+LNY
  465. 6830 IF CMD AND 4 THEN MMX=ARS:LNX=60:CPX=ASS:IF BDS*RSS!<CPX-LNX THEN LNX=CPX-BDS*RSS!
  466. 6840 IF CMD AND 8 THEN MMY=ASM:LNY=0:CPY=ARM:IF BDM*RSM!<CPY-LNY THEN LNY=CPY-BDM*RSM!
  467. 6850 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,0
  468. 6860 MMX=MOUSE(0):MMY=MOUSE(1):ON CMD GOSUB 6880,6900,6890,6920,20,6910,20,6940,6930,20,20,6950:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:GOSUB 6960:GOSUB 7010
  469. 6870 IF MOUSE(6,0)<>0 THEN GOSUB 6960:GOTO 6650 ELSE IF MOUSE(2,1) THEN 7020 ELSE 6860
  470. 6880 ASS=MMX:RETURN
  471. 6890 GOSUB 6880
  472. 6900 ARM=MMY:RETURN
  473. 6910 GOSUB 6900
  474. 6920 ARS=MMX:RETURN
  475. 6930 GOSUB 6880
  476. 6940 ASM=MMY:RETURN
  477. 6950 GOSUB 6920:GOTO 6940
  478. 6960 LNX=639-ASS:LNY=ASM:XST=LNY/RSM!:YST=LNX/RSS!:LNX=ASS-ARS:LNY=ARM-ASM+1:XEN=((LNY/RSM!)\8)*8-1:YEN=LNX/RSS!
  479. 6970 IF CMD MOD 3 THEN IF CMD=1 OR CMD=4 THEN XST=OOXST:XEN=OOXEN ELSE YST=OOYST:YEN=OOYEN
  480. 6980 IF XEN<7 THEN XEN=7 ELSE IF XEN>=BDM THEN XEN=BDM-1
  481. 6990 IF XEN<7 THEN XEN=7 ELSE IF YEN>=BDS THEN YEN=BDS-1
  482. 7000 RETURN
  483. 7010 LOCATE 0,23:PRINT USING " スキップ長  主:#### 副:####    読み取り長  主:#### 副:####";XST;YST;XEN+1;YEN+1;:RETURN
  484. 7020 IF CMD MOD 3=0 THEN RETURN ELSE MOUSE 4,0,0,639,479:GOSUB 6960:CPX=MOUSE(9):CPY=MOUSE(10):WHILE MOUSE(6,1)=0 AND MOUSE(6,0)=0:IF CMD=2 OR CMD=8 THEN 7080
  485. 7030 CPY=MOUSE(9):IF CPY=0 THEN 7130 ELSE IF CMD=4 THEN YEN=YEN-CPY ELSE YST=YST-CPY:YEN=YEN+CPY
  486. 7040 IF YST<0 THEN YST=0
  487. 7050 IF YEN>=BDS THEN YEN=BDS-1
  488. 7060 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 7060 ELSE YEN=YEN-1:GOTO 7060
  489. 7070 ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS:GOTO 7130
  490. 7080 CPX=MOUSE(10):IF CPX=0 THEN 7130 ELSE IF CMD=2 THEN XEN=XEN+CPX ELSE XST=XST+CPX:XEN=XEN-CPX
  491. 7090 IF XST<0 THEN XST=0
  492. 7100 IF XEN>=BDM THEN XEN=BDM-1
  493. 7110 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 7110 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 7110
  494. 7120 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1
  495. 7130 GOSUB 7010:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:WEND
  496. 7140 IF CMD=1 THEN MMX=ASS ELSE IF CMD=2 THEN MMY=ARM ELSE IF CMD=4 THEN MMX=ARS ELSE MMY=ASM
  497. 7150 GOTO 6800
  498. 7160 LNX=ASS-ARS:LNY=ARM-ASM:MOUSE 1,ARS,ASM,0:MOUSE 4,60,0,639-LNX,423-LNY
  499. 7170 MMX=MOUSE(0):MMY=MOUSE(1):LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:GOSUB 7210:GOSUB 7010
  500. 7180 IF MOUSE(6,0)<>0 THEN 7190 ELSE IF MOUSE(2,1) THEN A=MOUSE(6,1):GOTO 7200 ELSE 7170
  501. 7190 GOSUB 7210:GOTO 6650
  502. 7200 GOTO 7170
  503. 7210 ARS=MMX:ASM=MMY:ASS=ARS+LNX:ARM=ASM+LNY:PCX=639-ASS:PCY=ASM:XST=PCY/RSM!:YST=PCX/RSS!:RETURN
  504. 7220 IF MMX<551 THEN XST=OXST:YST=OYST:XEN=OXEN:YEN=OYEN
  505. 7230 CLS 4:LINE (0,0)-(58,423),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOTO *MENU
  506. 7240 LINE (ASS,ASM)-(ARS,ARM),PSET,0,B:PUT@ (ASS,ASM)-(ARS,ASM),G%,PSET,4:PUT@ (ASS,ARM)-(ARS,ARM),CH%,PSET,4:PUT@ (ASS,ASM)-(ASS,ARM),G2%,PSET,4:PUT@ (ARS,ASM)-(ARS,ARM),G3%,PSET,4:LINE (60,0)-(639,423),PSET,7,B:RETURN
  507. 7250 GET@ (ASS,ASM)-(ARS,ASM),G%,4,5,6,7:GET@ (ASS,ARM)-(ARS,ARM),CH%,4,5,6,7:GET@ (ASS,ASM)-(ASS,ARM),G2%,4,5,6,7:GET@ (ARS,ASM)-(ARS,ARM),G3%,4,5,6,7:RETURN
  508. 7251 *SCROLL_CHECK_FC:SWAP FCX,MMX:SWAP FCY,MMY:GOSUB *SCROLL_CHECK:SWAP FCX,MMX:SWAP FCY,MMY:RETURN
  509. 7253 *SCROLL_CHECK:IF SCRLM=0 THEN RETURN
  510. 7254  IF MMX<=BSX THEN X=0 ELSE X=MMX-BSX
  511. 7255  IF MMY<=BSY THEN Y=0 ELSE Y=MMY-BSY
  512. 7256  *SCROLL_CHECK_IN:ON SCM+1 GOSUB *SS0,*SS1,*SS2:RETURN
  513. 7257  *SS0:FA=(X \ 8)+Y*128:HAJ=138-(X MOD 8):GOSUB *OUT0:RETURN
  514. 7258  *SS1:FA=(X \ 2)+Y*256:HAJ=138-(X MOD 2)*2:GOSUB *OUT0:RETURN
  515. 7259  *SS2:FA=(X \ 8)+Y*128:HAJ=138-(X MOD 8):GOSUB *OUT0:GOSUB *OUT1:RETURN
  516. 7260  *OUT0:OUT &H440,17:OUT &H442,FA,2:OUT &H440,18:OUT &H442,HAJ,2:RETURN
  517. 7261  *OUT1:OUT &H440,21:OUT &H442,FA,2:OUT &H440,22:OUT &H442,HAJ,2:RETURN
  518. 7265 *SCRL_INI:IF SCRLM=0 THEN RETURN ELSE X=0:Y=0:GOTO *SCROLL_CHECK_IN
  519. 7270 *MOUSE_SCRL_GET:MOUSE 4,0,0,MVX,MVY:WHILE MOUSE(2,0)=0:MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *SCRL_INI:RETURN
  520. 7280 *FILE:GOSUB *SCAN_PUT:GOSUB *FBOX_CHK:GOSUB 7660:OSCM=SCM:GOSUB 7720:MOUSE 4,0,0,MVX,MVY:IF SAF=1 THEN GOSUB 7510
  521. 7290 IF MOUSE(2,1) THEN WHILE MOUSE(6,1)=0:WEND:GOTO 7440
  522. 7300 IF MOUSE(2,0) THEN A=MOUSE(6,0) ELSE MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:GOTO 7290
  523. 7310 IF MMX>9 AND MMX<311 AND MMY>=MCY AND MMY<=MCY+36 THEN 7520
  524. 7320 IF SAF=0 THEN 7460 ELSE GOSUB 7510:CMD=0:IF NOT(MMX>FCX-DI AND MMX<FCX+XLEN+DI AND MMY<FCY+YLEN+DI AND MMY>FCY-DI) THEN 7460
  525. 7330 IF ABS(MMX-FCX)<DI THEN CMD=1 ELSE IF ABS(MMX-(FCX+XLEN-1))<DI THEN CMD=2
  526. 7340 IF ABS(MMY-FCY)<DI THEN CMD=CMD+4 ELSE IF ABS(MMY-(FCY+YLEN-1))<DI THEN CMD=CMD+8
  527. 7350 IF CMD=0 THEN GOSUB 7630:WHILE MOUSE(6,0)=0:FCX=MOUSE(0):FCY=MOUSE(1):GOSUB *SCROLL_CHECK_FC:FCX=FCX-LNX:FCY=FCY-LNY:GOSUB 7510:GOSUB 7710:GOSUB 7510:WEND:GOSUB 7510:SAF=1:MOUSE 4,0,0,MVX,MVY:GOTO 7290
  528. 7360 LNX=MMX:LNY=MMY:CPX=MMX:CPY=MMY:MMX=FCX+XLEN-1:MMY=FCY+YLEN-1:IF CMD AND 1 THEN LNX=0:CPX=MMX:MMX=FCX:FCX=CPX ELSE IF CMD AND 2 THEN LNX=FCX:CPX=MVX
  529. 7370 IF CMD AND 4 THEN LNY=0:CPY=MMY:MMY=FCY:FCY=CPY ELSE IF CMD AND 8 THEN LNY=FCY:CPY=MVY
  530. 7380 IF CPX>MVX THEN CPX=MVX
  531. 7390 IF CPY>MVY THEN CPY=MVY
  532. 7400 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,1:WHILE MOUSE(6,0)=0:ON CMD GOSUB 7410,7410,20,7430,7420,7420,20,7430,7420,7420:GOSUB *SCROLL_CHECK:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:GOSUB 7500:MOUSE 4,0,0,MVX,MVY:GOTO 7470
  533. 7410 MMX=MOUSE(0):XLEN=ABS(MMX-FCX)+1:RETURN
  534. 7420 GOSUB 7410
  535. 7430 MMY=MOUSE(1):YLEN=ABS(MMY-FCY)+1:RETURN
  536. 7440 IF SAF=1 THEN GOSUB 7510
  537. 7450 A=MOUSE(6,0):A&=CALLM(OFFSET&,8):GOSUB 7690:IF MOUSE(2,0)=0 AND (A& AND 16)<>16 THEN MMM=1-(MMM AND 1) ELSE MMM=MMM+2:IF MOUSE(2,0)<>0 THEN WHILE MOUSE(6,0)=0:WEND
  538. 7455 GOSUB 7660:GOSUB 7720:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290 
  539. 7460 FCX=MMX:FCY=MMY:GOSUB 7620:GOSUB 7500
  540. 7470 SAF=1:IF MMX<FCX THEN SWAP MMX,FCX
  541. 7480 IF MMY<FCY THEN SWAP MMY,FCY
  542. 7490 GOSUB 7710:GOTO 7290
  543. 7500 LINE (FCX,FCY)-(MMX,MMY),XOR,7,B:RETURN
  544. 7510 LINE (FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1),XOR,7,B:RETURN
  545. 7520 MMY=MMY-MCY:IF MMY>18 THEN 7580 ELSE GOSUB 7730:IF SAF=1 THEN GOSUB 7510
  546. 7530 IF MMX>226 THEN SCM=OSCM:GOSUB 7690:GOTO *MENU
  547. 7540 IF MMX>122 THEN TM$="全領域セーブ":RWFLG=1:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *GSAVE_SUB1:GOTO 7570
  548. 7550 IF MMX>68 THEN TM$="セーブ":RWFLG=1:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *GSAVE_SUB2:GOTO 7570
  549. 7560 TM$="ロード":RWFLG=0:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *CHECK_COMP:IF YN=0 THEN 7570 ELSE LOAD@ DFD$+DFF$:GOSUB *PALETTE_LOAD:GOSUB *PALETTE_CHANGE:GOSUB *PALETTE_INI
  550. 7570 GOSUB 7660:GOSUB 7720:ON ERROR GOTO 0:MOUSE 4,0,0,MVX,MVY:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290
  551. 7580 IF MMX>288 THEN GOSUB 7730:GOTO 7440
  552. 7590 IF MMX>114 THEN GOSUB 7700:GOSUB 7730:GOSUB 7710:GOTO 7290
  553. 7600 GOSUB 7730:SCM=SCM+1:IF SCM>2 THEN SCM=0
  554. 7610 CLS:GOSUB *SCREEN_MODE:GOSUB 7660:GOSUB 7720:MOUSE 4,0,0,MVX,MVY:MOUSE 1,MMX,MMY+MCY,1:SAF=0:GOTO 7290
  555. 7620 WHILE MOUSE(6,0)=0:MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:XLEN=ABS(MMX-FCX)+1:YLEN=ABS(MMY-FCY)+1:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:RETURN
  556. 7630 LNX=MVX-(FCX+XLEN-1)+MMX:IF LNX>MVX THEN LNX=MVX
  557. 7640 LNY=MVY-(FCY+YLEN-1)+MMY:IF LNY>MVY THEN LNY=MVY
  558. 7650 MOUSE 4,MMX-FCX,MMY-FCY,LNX,LNY:LNX=MMX-FCX:LNY=MMY-FCY:RETURN
  559. 7660 IF MMM=0 THEN MCY=10 ELSE IF MMM=1 THEN MCY=160 ELSE MCY=512
  560. 7670 GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,4,BF,1:SYMBOL (16,MCY+2),"ロード セーブ 全領域セーブ メニュー",1,1,4:SYMBOL (12,MCY+20),"ScreenMode"+STR$(SCM)+" (    ,   )-(    ,   ) ◆",1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,4
  561. 7680 LINE (68,MCY)-(122,MCY+18),PSET,4,B:LINE (226,MCY)-(226,MCY+18),PSET,4:LINE (114,MCY+18)-(288,MCY+36),PSET,4,B:RETURN
  562. 7690 PUT@A (10,MCY)-(310,MCY+36),G%,PSET:RETURN
  563. 7700 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF:SYMBOL (116,MCY+20),"セーブ領域 ("+FNG$(XLEN)+","+FNF$(YLEN)+")",1,1,4:RETURN
  564. 7710 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF
  565. 7720 SYMBOL (116,MCY+20),"("+FNG$(FCX)+","+FNF$(FCY)+")-("+FNG$(FCX+XLEN-1)+","+FNF$(FCY+YLEN-1)+")",1,1,4:RETURN
  566. 7730 WHILE MOUSE(6,0)=0:WEND:RETURN
  567. 7740 ON ERROR GOTO 7990:GOSUB 7690
  568. 7750 GOSUB *INPUT:YN=FDFLG:IF YN=0 THEN RETURN
  569. 7760 ON ERROR GOTO 7990:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 7790
  570. 7770 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN
  571. 7780 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF"
  572. 7790 DFF$=PATH$+DFF$:RETURN
  573. 7840 *INPUT
  574. 7850 RADBUT=0:RCMD=1:WC$="*.TIF":FDM$="目的の.TIFファイルを設定して下さい。"
  575. 7860 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN 7570 ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\"
  576. 7870 DFD$=DRIVE$:DFF$=F_NAME$:IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&:RETURN ELSE RETURN
  577. 7880 *ERR_GET_PIC:GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,2,BF,1:RETURN
  578. 7885 *ERR_COMP:M$="現バージョンでは圧縮TIFFは未サポートです":GOSUB 8170:RETURN
  579. 7990 GOSUB *ERR_GET_PIC:ERRV=ERR:IF ERR=112 THEN M$="画面モードを正しく合わせてください":GOSUB 8170:RESUME NEXT
  580. 7995 IF ERR=28 AND ERL=7560 THEN GOSUB *ERR_COMP:RESUME 7570
  581. 8000 IF ERR=64 THEN M$="指定のファイルは既に存在しています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE KILL DFD$+DFF$:RESUME
  582. 8010 IF ERR=53 THEN M$="入出力装置に異常が発生しました":GOSUB 8170:RESUME NEXT
  583. 8020 IF ERR=55 THEN M$="ファイルの記述に誤りがあります":GOSUB 8170:RESUME NEXT
  584. 8030 IF ERR=60 THEN M$="指定の入出力装置は使用できません":GOSUB 8170:RESUME NEXT
  585. 8040 IF ERR=63 THEN M$="指定のファイルが見つかりません":GOSUB 8170:RESUME NEXT
  586. 8050 IF ERR=65 THEN M$="ディスクのディレクトリ領域がいっぱいです":GOSUB 8170:RESUME NEXT
  587. 8060 IF ERR=67 THEN M$="ディスクに空き領域がありません":GOSUB 8170:RESUME NEXT
  588. 8070 IF ERR=71 THEN M$="ディスクのファイルの構成が正しくありません":GOSUB 8170:RESUME NEXT
  589. 8080 IF ERR=72 THEN M$="ディスク装置が使用可能な状態になっていません":GOSUB 8170:RESUME NEXT
  590. 8090 IF ERR=73 THEN M$="指定されたディスクは書込が禁止されています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE RESUME
  591. 8100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 8170:RESUME NEXT
  592. 8110 PRINT "エラーが発生しました。 ID =";ERR;" Line =";ERL:CALLM RCLOSE&,PIT&:END
  593. 8120 GOSUB 8150:SYMBOL (180,MCY+20),"中断   続行",1,1,4:SYMBOL (212,MCY+28),"[取消]        [実行]",.5!,.5!,5:LINE (180,MCY+18)-(235,MCY+36),PSET,2,B:LINE (291,MCY+18)-(291,MCY+36),PSET,2:MOUSE 1,212,MCY+24,1:MOUSE 4,180,MCY+18,291,MCY+36
  594. 8130 A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$="" THEN WHILE MOUSE(6,0)=0:WEND:YN=MOUSE(0)\231:GOSUB 7690:RETURN
  595. 8140 YN=SGN(24-ASC(A$)):GOSUB 7690:RETURN
  596. 8150 ML=KLEN(M$):IF ML<19 THEN SYMBOL (16,MCY+2),M$,1,1,4 ELSE IF ML<25 THEN SYMBOL (16,MCY+2),M$,.75!,1,4 ELSE SYMBOL (16,MCY+2),M$,.5!,1,4
  597. 8160 SYMBOL (12,MCY+20),"Error ID ="+FNF$(ERRV),1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,2:RETURN
  598. 8170 GOSUB 8150:SYMBOL (240,MCY+20),"確認",1,1,4:LINE (238,MCY+18)-(273,MCY+36),PSET,2,B:MOUSE 1,256,MCY+24,1:MOUSE 4,238,MCY+18,273,MCY+36:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB 7690:RETURN
  599. 8180 LINE (124,MCY+1)-(307,MCY+17),PSET,0,BF:RETURN
  600. 8190 *FBOX_CHK:IF FCX+XLEN-1>MVX THEN FCX=0:XLEN=8
  601. 8200 IF FCY+YLEN-1>MVY THEN FCY=0:YLEN=8
  602. 8210 RETURN
  603. 8220 *END:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,0,BF,7:SYMBOL (MCX+4,MCY+22),"プログラムを終了します",1,1,0:SYMBOL (MCX+3,MCY+101),"  取消            実行",1,1,0:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,0:LINE (MCX+66,MCY+99)-(MCX+132,MCY+119),PSET,0,B
  604. 8230 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 8230 ELSE IF A<>0 THEN IF A=24 THEN *MENU_IN ELSE 8260
  605. 8240 CMD=MMX \ 66:ON CMD+1 GOTO *MENU_IN,8250,8260
  606. 8250 GOSUB *PALETTE_CHANGE:MOUSE 1,,,0:PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:GOSUB *MOUSE_SCRL_GET:GOTO *MENU
  607. 8260 PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:IF INKEY$=CHR$(27) THEN END ELSE SYSTEM
  608. 8270 *SCREEN_MODE:A&=CALLM(OFFSET&,8):IF NOT((A& AND 20)<>0 AND SCM=1) AND PSCM=SCM THEN RETURN ELSE IF NOT(SCM=1) AND SCRLM=0 THEN 8307 ELSE IF (A& AND 20)=16 AND SCM=1 THEN SCRLM=1:GOTO 8277
  609. 8275 *SCREEN_MODE_IN:IF ZMFV<>0 THEN ON SCM+1 GOTO 8280,8295,8300
  610. 8277 ON SCM+1 GOTO 8280,8290,8300
  611. 8280 SCREEN@ 0:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):PSCM=0:ZMFV=0:IF SCRLM=2 THEN GOSUB *SM3:RETURN ELSE GOSUB *SM0:RETURN
  612. 8290 IF NOT((A& AND 20)=4) THEN SCREEN@ 1:WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):PSCM=1:ZMFV=0:IF SCRLM=1 THEN IF MSF=0 THEN GOSUB *SM1:RETURN ELSE GOSUB *SM04:RETURN
  613. 8295 SCREEN@ 1,1,(64,112):WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):GOSUB *SM4:PSCM=1:ZMFV=1:RETURN
  614. 8300 SCREEN@ 2:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):PSCM=2:ZMFV=0:IF SCRLM=2 THEN GOSUB *SM5:RETURN ELSE GOSUB *SM2:RETURN
  615. 8307 IF (A& AND 20)=4 THEN SCRLM=2
  616. 8308 GOTO 8277
  617. 8310 *SCREEN_CALC2:IF SCRLM<>1 THEN SCM=SCM+3
  618. 8311 GOTO *SCREEN_CALC_IN
  619. 8312 *SCREEN_CALC:A&=CALLM(OFFSET&,8):IF (A& AND 20)=4 THEN SCM=SCM+3
  620. 8315 *SCREEN_CALC_IN:ON SCM+1 GOTO *SM0,*SM1,*SM2,*SM3,*SM04,*SM5
  621. 8320 *SM0:BDX=639:BDY=479:GOSUB *MVSET02:BSX=639:BSY=479:SCRLM=1:RETURN
  622. 8325 *SM3:BDX=1023:BDY=511:MVX=1023:MVY=511:BSX=639:BSY=479:SCRLM=2:SCM=0:RETURN
  623. 8330 *SM1:BDX=511:BDY=255:GOSUB *MVSET1:BSX=319:BSY=239:SCRLM=1:MSF=0:RETURN
  624. 8335 *SM04:IF ZMFV=0 THEN GOSUB *SM4:BSX=319:BSY=239:SCRLM=1:MSF=1:RETURN
  625. 8337 *SM4:BDX=511:BDY=255:MVX=511:MVY=255:BSX=511:BSY=255:SCRLM=0:SCM=1:MSF=1:RETURN
  626. 8340 *SM2:BDX=639:BDY=479:GOSUB *MVSET02:BSX=639:BSY=479:SCRLM=1:RETURN
  627. 8341 *SM5:BDX=1023:BDY=511:MVX=1023:MVY=511:BSX=639:BSY=479:SCRLM=2:SCM=2:RETURN
  628. 8342 *MVSET02:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN MVX=1023:MVY=511:RETURN ELSE MVX=639:MVY=511:RETURN
  629. 8345 *MVSET1:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN MVX=511:MVY=255:RETURN ELSE MVX=319:MVY=255:RETURN
  630. 8350 *PALETTE_SET:IF PSCM=1 THEN RETURN ELSE PALETTE
  631. 8360 IF SCM=2 THEN 8370 ELSE *PALETTE_CHANGE
  632. 8370 ON PALM GOTO 8380,*PALETTE_CHANGE,*PALETTE_CHANGE:RETURN
  633. 8380 ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:GOSUB *PALETTE_CHANGE:RETURN
  634. 8390 *PAL_PAL:OFPAL=FPAL:FPAL=PAL2 MOD 3:ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:FPAL=OFPAL:RETURN
  635. 8400 FOR A=0 TO 255:PAL&(A)=A*65536+A*256+A:NEXT:RETURN
  636. 8410 FOR A=0 TO 255:PAL&(A)=A*256:NEXT:RETURN
  637. 8420 FOR A=0 TO 255:PAL&(A)=A*65536:NEXT:RETURN
  638. 8430 FOR A=0 TO 255:PAL&(A)=A:NEXT:RETURN
  639. 8440 ON FPAL GOTO 8450,8460:RETURN
  640. 8450 FOR A=0 TO 7:PAL&(A)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(8)=0:RETURN
  641. 8460 PAL&(0)=0:PAL&(8)=4210752:FOR A=1 TO 7:PAL&(A)=((IP%(A,1)+1)\2)*65536+((IP%(A,2)+1)\2)*256+((IP%(A,3)+1)\2):PAL&(A+8)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(16)=0:RETURN
  642. 8470 *PALETTE_CHANGE:IF SCM<>PSCM THEN RETURN
  643. 8480 ON SCM+1 GOTO 8500,8490,8510
  644. 8490 RETURN
  645. 8500 FOR A=0 TO 15:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  646. 8510 FOR A=0 TO 255:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
  647. 8520 *PALETTE_INI:IF SCM<>PSCM THEN RETURN
  648. 8530 ON PSCM+1 GOTO 8550,8540,8560
  649. 8540 RETURN
  650. 8550 FOR A=0 TO 7:PALETTE A+SGN(A)*8,[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
  651. 8560 FOR A=0 TO 7:PALETTE IP%(A,0),[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
  652. 8570 *PALETTE_UNDO:IF SCM<>PSCM THEN RETURN
  653. 8580 ON PSCM+1 GOTO 8600,8590,8610
  654. 8590 RETURN
  655. 8600 FOR A=0 TO 7:B=A+SGN(A)*8:PALETTE B,[(PAL&(B) AND 16711680)\65536,(PAL&(B) AND 65280)\256,PAL&(B) AND 255]:NEXT:RETURN
  656. 8610 FOR A=0 TO 7:K=IP%(A,0):PALETTE K,[(PAL&(K) AND 16711680)\65536,(PAL&(K) AND 65280)\256,PAL&(K) AND 255]:NEXT:RETURN
  657. 8620 *PALETTE_SAVE:RETURN
  658. 8630 *PALETTE_LOAD:PS$=DFD$+DFF$
  659. 8640 *PALETTE_LOAD_IN:GOSUB *CHECK_TAG6:CLOSE:IF YN=0 THEN PS$=LEFT$(PS$,LEN(PS$)-4)+".PLT":ON ERROR GOTO 8760:IF SCM<>1 THEN 8730
  660. 8720 ON ERROR GOTO 0:RETURN
  661. 8730 OPEN "I",#1,PS$:A!=CVL(INPUT$(4,1)):CLOSE:IF HEX$(A!)="F0000000" THEN *PALETTE_PALETTE ELSE ON SCM+1 GOTO 8740,8720,8750
  662. 8740 OPEN "I",#1,PS$:FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:CLOSE:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
  663. 8750 LOAD@ PS$,PAL&:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
  664. 8760 IF ERR=63 THEN GOSUB *PALETTE_PALETTE:RESUME 8720
  665. 8770 PRINT "Error ";ERR;" in ";ERL:CALLM RCLOSE&,PIT&:END
  666. 8780 *PALETTE_FIX:ON CMD+1 GOSUB *PALETTE_PALETTE,8790,8810,8840,8870:GOSUB *PALETTE_CHANGE:RETURN
  667. 8790 PAL&(0)=0:IF PSCM=0 THEN PAL&(7)=8421504:PAL&(15)=16777215:RETURN
  668. 8800 PAL&(182)=12566463:PAL&(255)=16777215:RETURN
  669. 8810 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE:RETURN
  670. 8820 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31:A!=263172*A:GOSUB 8880:PAL&(A)=A!:A!=263172*A:GOSUB 8880:PAL&(255-A)=A!:NEXT:FOR B=1 TO 6:FOR A=0 TO 31:A!=BY&(B)*((31-A)*8+7):GOSUB 8880:PAL&(B*32+A)=A!:NEXT:NEXT
  671. 8830 FOR A=0 TO 31:A!=8618883+263172*A:GOSUB 8880:PAL&(224+A)=A!:NEXT:RETURN
  672. 8840 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE_IN:FOR A=1 TO 7:SWAP PAL&(A),PAL&(A+8):NEXT:RETURN
  673. 8850 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31 STEP 2:FOR B=1 TO 6:A!=BY&(B)*((31-(A\2))*8+7):GOSUB 8880:PAL&(A*8+B)=A!:A!=BY&(B)*((15-(A\2))*8+7):GOSUB 8880:PAL&((A+1)*8+B)=A!:NEXT:NEXT
  674. 8860 FOR A=0 TO 31 STEP 2:A!=263172*(A\2):GOSUB 8880:PAL&(A*8)=A!:A!=263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8)=A!:A!=16777215-263172*(A\2):GOSUB 8880:PAL&(A*8+7)=A!:A!=16777215-263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8+7)=A!:NEXT:RETURN
  675. 8870 GOSUB *PAL_PAL:RETURN
  676. 8880 IF A!>=2147483648# THEN A!=A!-4294967296#
  677. 8890 RETURN
  678. 8900 SCREEN@ 0:CLS:PALETTE:FOR A=0 TO 255:PRINT USING "### : [G : ###  R : ###  B : ### ]";A;(PAL&(A) AND 16711680)\65536;(PAL&(A) AND 65280)\256;PAL&(A) AND 255:A$=INPUT$(1):NEXT:CALLM RCLOSE&,PIT&:END
  679. 8910 SCREEN@ 0:CLS:PALETTE:A#=8421504:PRINT USING "[G : ###  R : ###  B : ### ]";(A# AND 16711680)\65536;(A# AND 65280)\256;A# AND 255:A$=INPUT$(1):CALLM RCLOSE&,PIT&:END
  680. 8920 *PALETTE_PALETTE:ON ERROR GOTO 0:ON PSCM+1 GOTO 8940,8930,8950
  681. 8930 RETURN
  682. 8940 GOSUB 8970:PALETTE:RETURN
  683. 8950 GOSUB *INI256:PALETTE:RETURN
  684. 8960 *PALETTE_PALETTE_IN:ON ERROR GOTO 0:ON SCM+1 GOTO 8970,8930,*INI256
  685. 8970 GOSUB *INI256:RESTORE 8990:FOR A=0 TO 15:READ PAL&(A):NEXT:A&=16:RETURN
  686. 8980 *INI256:A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:PAL&(A)=(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)):A=A+1:NEXT:NEXT:NEXT:A&=256:RETURN
  687. 8990 DATA 0,128,32768,32896,8388608,8388736,8421376,8421504,4210752,255,65280,65535,16711680,16711935,16776960,16777215
  688. 9000 DATA 8158332,255,65280,65535,16711680,16711935,16776960,16777215,                263172,7,1792,1799,458752,458759,460544,263172
  689. 9010 DATA 1,256,257,65536,65537,65792
  690. 9100 *CHECK_TAG6
  691. 9110 ON ERROR GOTO 8760:OPEN "I",#1,PS$
  692. 9130  DUM$=INPUT$(&H36,1):DUM$=INPUT$(2,1):BIT=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256
  693. 9140 IF BIT<>4 AND BIT<>8 THEN GOSUB *PALETTE_PALETTE:YN=0:RETURN
  694. 9150 DUM$=INPUT$(22,1):DUM$=INPUT$(2,1):PYNF=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256
  695. 9160 IF PYNF<>3 THEN GOSUB *PALETTE_PALETTE:YN=0:RETURN
  696. 9170 DUM$=INPUT$(118,1):DUM$=INPUT$(2,1):POLN&=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:DUM$=INPUT$(2,1):POLN&=POLN&+(ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256)*65536:POLN&=POLN&-&HCA
  697. 9180 WHILE POLN&>255:DUM$=INPUT$(255,1):POLN&=POLN&-255:WEND:IF POLN&<>0 THEN DUM$=INPUT$(POLN&,1)
  698. 9190 IF BIT=8 THEN A&=256 ELSE A&=16
  699. 9200 *TAG_PAL
  700. 9210 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=ASC(RIGHT$(DUM$,1))*256:NEXT
  701. 9220 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=PAL&(A)+ASC(RIGHT$(DUM$,1))*65536:NEXT
  702. 9230 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=PAL&(A)+ASC(RIGHT$(DUM$,1)):NEXT
  703. 9240 YN=1:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
  704. 9500 *GSAVE_SUB1:GOSUB *PALETTE_CHANGE_CHECK:IF SCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ DFD$+DFF$,(0,0)-(MVX,MVY),YN ELSE SAVE@ DFD$+DFF$,(0,0)-(MVX,MVY)
  705. 9510 RETURN
  706. 9550 *GSAVE_SUB2:GOSUB *PALETTE_CHANGE_CHECK:IF SCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ DFD$+DFF$,(FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1),YN ELSE SAVE@ DFD$+DFF$,(FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1)
  707. 9560 RETURN
  708. 9600 *CHECK_COMP
  709. 9610  ON ERROR GOTO *CHECK_ERR
  710. 9630  OPEN "I",#1,DFD$+DFF$
  711. 9640  DUM$=INPUT$(&H42,1):DUM$=INPUT$(2,1):CMPFLG%=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:CLOSE #1
  712. 9650  IF CMPFLG%<>1 THEN GOSUB *ERR_GET_PIC:ERRV=28:GOSUB *ERR_COMP:YN=0:RETURN
  713. 9660  *CHECK_RET
  714. 9670  ON ERROR GOTO 7990:YN=1:RETURN
  715. 9680 *CHECK_ERR
  716. 9690  RESUME *CHECK_RET
  717. 9800 *PALETTE_CHANGE_CHECK:YN=0:ON SCM+1 GOTO 9810,9850,9830
  718. 9810 RESTORE 8990:FOR A=0 TO 15:READ PV&:IF PAL&(A)<>PV& THEN YN=1
  719. 9820 NEXT:RETURN
  720. 9830 A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:IF PAL&(A)<>(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)) THEN YN=1
  721. 9840 A=A+1:NEXT:NEXT:NEXT:RETURN
  722. 9850 RETURN
  723. 10000 *PF_PALETTE
  724. 10010 PALETTE:RETURN
  725. 15000 *DEPTH_SET:DFB=DFO:A&=CALLM(OFFSET&,8):IF (A& AND 20)=0 THEN PAR$=CHR$(DFO):RETURN
  726. 15010 IF (A& AND 20)=20 THEN DFB=DFB-3:GOTO *DEPTHRET
  727. 15020 IF (A& AND 4)=4 THEN DFB=DFB-1:GOTO *DEPTHRET
  728. 15030 DFB=DFB-2
  729. 15040 *DEPTHRET:IF DFB<3 THEN DFB=3
  730. 15050 PAR$=CHR$(DFB):RETURN
  731. 60000 *FILE_DIALOG:ON ERROR GOTO *エラー処理
  732. 60010 ON RIFLG+1 GOTO *RADBUT_IN0,*RADBUT_IN1,*RADBUT_IN2
  733. 60020 *RADBUT_IN0
  734. 60030 FSCM=PSCM:GET@A (0,0)-(511+512*ABS(SGN(PSCM-1)),255+256*ABS(SGN(PSCM-1))),GBAK%:SCREEN@ 0:CONSOLE 0,25:COLOR 7,,,0:CLS:PALETTE
  735. 60040 MOUSE 0:MOUSE 1,FDXM+200,FDYM+320,1:MOUSE 4,FDXM+25,FDYM-4,FDXM+320,FDYM+349
  736. 60050 LOCATE FDX+21-(LEN(TM$)\2),FDY:PRINT TM$:LOCATE FDX+22,FDY+15:PRINT "実行  取消":LOCATE FDX+30,FDY+1:PRINT "    0KB":LOCATE FDX+22,FDY+4:PRINT "親"
  737. 60060 LOCATE FDX+22,FDY+5:PRINT "↑":LOCATE FDX+22,FDY+13:PRINT "↓":LOCATE FDX+6,FDY+2:PRINT "《  Q  》"
  738. 60070 LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,B
  739. 60080 LINE(FDXM+38,FDYM+283)-(FDXM+153,FDYM+302),PSET,7,B:LINE(FDXM+38,FDYM+74)-(FDXM+153,FDYM+92),PSET,7,B:LINE(FDXM+39,FDYM+26)-(FDXM+153,FDYM+64),PSET,7,B
  740. 60090 LINE(FDXM+172,FDYM+282)-(FDXM+209,FDYM+302),PSET,7,B:LINE(FDXM+220,FDYM+282)-(FDXM+257,FDYM+302),PSET,7,B:LINE(FDXM+236,FDYM+16)-(FDXM+297,FDYM+36),PSET,7,B
  741. 60100 LINE(FDXM+172,FDYM+74)-(FDXM+194,FDYM+92),PSET,7,B:LINE(FDXM+172,FDYM+94)-(FDXM+194,FDYM+112),PSET,7,B:LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,B
  742. 60110 LINE(FDXM+172,FDYM+245)-(FDXM+194,FDYM+264),PSET,7,B:LINE(FDXM+76,FDYM+26)-(FDXM+116,FDYM+64),PSET,7,B
  743. 60120 GOSUB *PUT_FDMES
  744. 60130 *初期化
  745. 60140 MOFF=0
  746. 60150 RESTORE *CLICK_AREA
  747. 60160 FOR I=1 TO MAXCMD
  748. 60170     FOR J=1 TO 4
  749. 60180         READ XY(I,J)
  750. 60190     NEXT J
  751. 60200 NEXT I
  752. 60210 *RADBUT_IN1
  753. 60220 GOSUB *RADIO_BUTTON
  754. 60230 GOSUB *接続ドライブ
  755. 60240 GOSUB *GETCD
  756. 60250 GOSUB *DRV_HYO
  757. 60260 GOSUB *GETDIR
  758. 60270 IF RET&=-1 THEN GOSUB *NOT_DRV:GOTO *FD_MAIN_LOOP
  759. 60280 GOSUB *SEARCH
  760. 60290 GOSUB *DISK_FREE
  761. 60300 GOSUB *SORT
  762. 60310 F_NUM=1
  763. 60320 GOSUB *HYOUJI
  764. 60330 *RADBUT_IN2:FDFLG=0
  765. 60340 *FD_MAIN_LOOP
  766. 60350 MX=MOUSE(0)-FDXM:MY=MOUSE(1)-FDYM
  767. 60360 J=0:A$=INKEY$:IF A$=CHR$(13) THEN J=CANCMD-1 ELSE IF A$=CHR$(24) THEN J=CANCMD
  768. 60370 FOR I=1 TO MAXCMD
  769. 60380     IF MOUSE(2,0) AND MX>XY(I,1) AND MX<XY(I,3) THEN IF MY>XY(I,2) AND MY<XY(I,4) THEN J=I:I=100
  770. 60390 NEXT I
  771. 60400 IF J THEN *ON_MOUSE
  772. 60410 GOTO *FD_MAIN_LOOP
  773. 60420 *ON_MOUSE
  774. 60430 IF MOFF AND J>3 AND J<>CANCMD AND J<>BUTCMD THEN *FD_MAIN_LOOP
  775. 60440 ON J GOSUB *ON_LEFT,*ON_DRV,*ON_RIGHT,*ON_OYA,*ON_LIST,*ON_UP,*ON_DOWN,*ON_RUN,*ON_CANCEL,*ON_INPUT,*ON_SCROLL_BAR,*ON_BUTTON
  776. 60450 GOTO *FD_MAIN_LOOP
  777. 60460 *ON_LEFT
  778. 60470 MOFF=1
  779. 60480 GOSUB *LEFT_DRV
  780. 60490 GOSUB *DRV_HYO
  781. 60500 GOSUB *HYOUJI:WAIT 10
  782. 60510 RETURN
  783. 60520 *ON_DRV
  784. 60530 WHILE MOUSE(2,0)<>0:WEND
  785. 60540 MOFF=0
  786. 60550 FILENAME$=""
  787. 60560 GOSUB *HYOUJI_SPC
  788. 60570 GOSUB *DRV_SENTAKU
  789. 60580 RETURN
  790. 60590 *ON_RIGHT
  791. 60600 MOFF=1
  792. 60610 GOSUB *RIGHT_DRV
  793. 60620 GOSUB *DRV_HYO
  794. 60630 GOSUB *HYOUJI:WAIT 10
  795. 60640 RETURN
  796. 60650 *ON_UP
  797. 60660 IF F_NUM>1 THEN F_NUM=F_NUM-1:GOSUB *HYOUJI
  798. 60670 RETURN
  799. 60680 *ON_DOWN
  800. 60690 IF F_NUM<F_S-8 THEN F_NUM=F_NUM+1:GOSUB *HYOUJI
  801. 60700 RETURN
  802. 60710 *ON_OYA
  803. 60720 WHILE MOUSE(2,0)<>0:WEND
  804. 60730 DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0)
  805. 60740 A=CALLM (OFFSET&,0,VARPTR(DUMMYP$),VARPTR(DUMMYY$),&H10,0)
  806. 60750 IF A=0 THEN SHELL "CD .."
  807. 60760 GOSUB *ON_DRV
  808. 60770 RETURN
  809. 60780 *ON_LIST
  810. 60790 I=0
  811. 60800 IF F_S<9 THEN K=F_S ELSE K=9
  812. 60810 IF K=0 OR FILE_SU=-1 THEN RETURN
  813. 60820 FOR J=1 TO K
  814. 60830     IF MY<95+19*J THEN I=J:J=10
  815. 60840 NEXT J
  816. 60850 IF I THEN GOSUB *SETFILE
  817. 60860 RETURN
  818. 60870 *SETFILE
  819. 60880 FILENAME$=MID$(FILE_NAME$(F_NUM+I-1+ROOT),2,14)
  820. 60890 IF ASC(FILENAME$)=60 THEN *SETDIR
  821. 60900 GOSUB *HYOUJI
  822. 60910 COLOR ,,,5:LOCATE FDX+5,FDY+4+I:PRINT " "+FNFF$(MID$(FILENAME$,2,12))+" ":COLOR 7,,,0
  823. 60920 LOCATE FDX+6,FDY+15:PRINT MID$(FILENAME$,2,12)
  824. 60930 RETURN
  825. 60940 *SETDIR
  826. 60950 DIR$=MID$(FILENAME$,2,12)
  827. 60960 GOSUB *CDDIRMOVE
  828. 60970 GOSUB *ON_DRV
  829. 60980 RETURN
  830. 60990 *ON_RUN
  831. 61000 IF LEFT$(MID$(FILENAME$,2,12)+SPACE$(12),12)=SPACE$(12) THEN RETURN ELSE FDFLG=1
  832. 61010 DRIVE$=MID$(DRV_SET$,DRV_NO,1)+":":PATH$=LEFT$(DIR$,INSTR(DIR$+" "," ")-1):F_NAME$=MID$(FILENAME$,2,12):F_NAME$=LEFT$(F_NAME$,INSTR(F_NAME$+" "," ")-1)
  833. 61020 RETURN *RET_RET
  834. 61030 *ON_CANCEL
  835. 61040 FDFLG=0
  836. 61050 RETURN *RET_RET
  837. 61060 *RET_RET:RIFLG=0:PSCM=10:SWAP FSCM,SCM:A&=0:GOSUB *SCREEN_MODE_IN:SWAP FSCM,SCM
  838. 61065 CLS:PUT@A (0,0)-(511+512*ABS(SGN(PSCM-1)),255+256*ABS(SGN(PSCM-1))),GBAK%:ON ERROR GOTO 0:RETURN
  839. 61070 *ON_INPUT:IF RWFLG=0 THEN RETURN
  840. 61080 FT$=MID$(FILENAME$,2,12):WHILE RIGHT$(FT$,1)=" ":FT$=LEFT$(FT$,LEN(FT$)-1):WEND
  841. 61090 CP=LEN(FT$)
  842. 61100 K$=""
  843. 61110 WHILE K$<>CHR$(13)
  844. 61120   CP=LEN(FT$):LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,1,BF:LINE ((FDX+6+CP)*8+1,FDYM+285)-((FDX+6+CP)*8+1,FDYM+300),PSET,2
  845. 61130     K$=INPUT$(1)
  846. 61140     IF K$=CHR$(8) OR K$=CHR$(29) THEN GOSUB *IN_DEL_LAST_C:GOTO *IN_PUT
  847. 61150     IF K$<CHR$(33) THEN *P_SKP ELSE FT$=FT$+K$
  848. 61160     CP=LEN(FT$):IF CP>12 THEN BEEP:FT$=LEFT$(FT$,12):CP=12:GOTO *P_SKP
  849. 61170     IF INSTR(FT$,".")>9 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  850. 61180     IF CP=9 AND INSTR(FT$,".")<2 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  851. 61190     IF CP>INSTR(FT$,".")+3 AND INSTR(FT$,".")>1 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
  852. 61200   *IN_PUT
  853. 61210    LOCATE FDX+6,FDY+15:PRINT LEFT$(FT$+"            ",12)+" "
  854. 61220   *P_SKP
  855. 61230 WEND
  856. 61240 LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,%8,BF
  857. 61250 FILENAME$="F"+LEFT$(FT$+"            ",12)+CHR$(0)
  858. 61260 RETURN
  859. 61270 *IN_DEL_LAST
  860. 61280 CP=LEN(FT$)-1:BEEP:FT$=LEFT$(FT$,CP):RETURN
  861. 61290 *IN_DEL_LAST_C
  862. 61300 IF LEN(FT$)=0 THEN BEEP:RETURN ELSE FT$=KLEFT$(FT$,KLEN(FT$)-1):CP=LEN(FT$):RETURN
  863. 61310 *ON_BUTTON
  864. 61320 OCMD=RCMD:RCMD=((MY-76)\19)+1
  865. 61330 IF RCMD>RADBUT THEN RCMD=OCMD:RETURN
  866. 61340 GOSUB *DISP_RADIO
  867. 61350 IF RETFLG(RCMD-1)=0 THEN RETURN ELSE RETURN *RADBUTRET
  868. 61360 *RADBUTRET
  869. 61370 FDFLG=2:RETURN
  870. 61380 *RADIO_BUTTON:IF RADBUT=0 THEN RETURN
  871. 61390 GOSUB *DISP_RADIO
  872. 61400 FOR I=0 TO RADBUT-1
  873. 61410   LOCATE FDX+27,FDY+4+I:PRINT RADBUT$(I)
  874. 61420 NEXT
  875. 61430 RETURN
  876. 61440 *DISP_RADIO:IF RADBUT=0 THEN RETURN
  877. 61450 FOR I=0 TO RADBUT-1
  878. 61460   LOCATE FDX+25,FDY+4+I:PRINT "○";
  879. 61470 NEXT
  880. 61480 IF RCMD<>0 THEN  LOCATE FDX+25,FDY+3+RCMD:PRINT "●";
  881. 61490 RETURN
  882. 61500 *SCROLL_BAR
  883. 61510 LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8
  884. 61520 IF MOFF=1 OR F_S<10 THEN IF MOFF=1 THEN RETURN ELSE LINE(FDXM+173,FDYM+113)-(FDXM+193,FDYM+244),PSET,0,BF,%15:RETURN
  885. 61530 BOX_Y1=BOX_S!*(F_NUM-1):BOX_Y2=130-(BOX_Y1+BOX_RH)
  886. 61540 IF BOX_Y2<0 THEN BOX_Y2=0
  887. 61550 IF BOX_Y1>B_MAX THEN BOX_Y1=B_MAX
  888. 61560 LINE (FDXM+173,FDYM+113+BOX_Y1)-(FDXM+193,FDYM+244-BOX_Y2),PSET,0,BF,%15
  889. 61570 RETURN
  890. 61580 *ON_SCROLL_BAR
  891. 61590 IF MOFF=1 OR F_S<10 THEN RETURN
  892. 61600 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
  893. 61610 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN RETURN
  894. 61620 IF MY<BOX_Y1+113 OR MY>244-BOX_Y2 THEN B_Y1=(MY-113-(BOX_RH/2)):GOTO *SCROLL_CLICK ELSE OI=257
  895. 61630 WHILE MOUSE(2,0)<>0:MY=MOUSE(1)-FDYM:B_Y1=(MY-113-(BOX_RH/2)):OI=I:I=B_Y1/BOX_S!
  896. 61640   IF I<0 THEN I=0
  897. 61650   IF I>F_S-9 THEN I=F_S-9
  898. 61660   I=I+1:B_Y1=BOX_S!*(I-1):B_Y2=130-(B_Y1+BOX_RH)
  899. 61670   IF B_Y2<0 THEN B_Y2=0
  900. 61680   IF B_Y1>B_MAX THEN B_Y1=B_MAX
  901. 61690   IF OI<>I THEN LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8:LINE (FDXM+173,FDYM+113+B_Y1)-(FDXM+193,FDYM+244-B_Y2),PSET,0,BF,%15
  902. 61700 WEND:GOTO *SCROLL_RET
  903. 61710 *SCROLL_CLICK:I=B_Y1/BOX_S!
  904. 61720 IF I<0 THEN I=0
  905. 61730 IF I>F_S-9 THEN I=F_S-9
  906. 61740 I=I+1
  907. 61750 *SCROLL_RET
  908. 61760 F_NUM=I:GOSUB *HYOUJI
  909. 61770 RETURN
  910. 61780 *LEFT_DRV
  911. 61790 DRV_NO=DRV_NO-1
  912. 61800 IF DRV_NO=0 THEN DRV_NO=DRV_SU
  913. 61810 RETURN
  914. 61820 *RIGHT_DRV
  915. 61830 DRV_NO=DRV_NO+1
  916. 61840 IF DRV_NO>DRV_SU THEN DRV_NO=1
  917. 61850 RETURN
  918. 61860 *DRV_SENTAKU
  919. 61870 F_NUM=1
  920. 61880 GOSUB *CDMOVE
  921. 61890 GOSUB *GETDIR
  922. 61900 IF RET&=-1 THEN GOSUB *NOT_DRV:RETURN
  923. 61910 GOSUB *SEARCH
  924. 61920 GOSUB *DISK_FREE
  925. 61930 GOSUB *SORT
  926. 61940 GOSUB *HYOUJI
  927. 61950 RETURN
  928. 61960 *GETCD
  929. 61980 DMMY$=CHR$(CALLM (OFFSET&,1))
  930. 61990 DRV_NO=INSTR(1,DRV_SET$,DMMY$)
  931. 62000 RETURN
  932. 62010 *GETDIR
  933. 62020 DMMY$=MID$(DRV_SET$,DRV_NO,1)
  934. 62030 DIR$=SPACE$(65)
  935. 62040 RET&=CALLM(OFFSET&,2,ASC(DMMY$),VARPTR(DIR$))
  936. 62050 I=KINSTR(DIR$,"\")
  937. 62060 J=I
  938. 62070 WHILE I
  939. 62080       J=I
  940. 62090       I=KINSTR(J+1,DIR$,"\") 
  941. 62100 WEND
  942. 62110 LOCATE FDX+6,FDY+4:PRINT KMID$(DIR$,J+1,12)
  943. 62120 RETURN
  944. 62130 *CDMOVE
  945. 62140 DMMY$=MID$(DRV_SET$,DRV_NO,1)
  946. 62150 SHELL DMMY$+":":'CALLM OFFSET&,3,asc(DMMY$)
  947. 62160 RETURN
  948. 62170 *CDDIRMOVE
  949. 62180 DIR$=DIR$+CHR$(0)
  950. 62190 CALLM OFFSET&,4,VARPTR(DIR$):'SHELL "CD "+DIR$
  951. 62200 RETURN
  952. 62210 *SEARCH:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%1:IF BASCOM=1 THEN *SEARCH_COM
  953. 62220 GOSUB *SEARCH_DIR
  954. 62230 PATH_ALL$=WC$+CHR$(0)
  955. 62240 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(FILE_SU+1)),0,0)
  956. 62250 IF A<>0 THEN RETURN ELSE FILE_SU=FILE_SU+1
  957. 62260 FILE_NAME$(FILE_SU)="2 "+MID$(FILE_NAME$(FILE_SU),2,12)+" "
  958. 62270 FOR I=FILE_SU+1 TO 256
  959. 62280     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),0,1)
  960. 62290     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUT ELSE FILE_SU=I
  961. 62300     KAKUNO$=FILE_NAME$(I)
  962. 62310     FILE_NAME$(I)="2 "+MID$(KAKUNO$,2,12)+" "
  963. 62320 *LOOPOUT
  964. 62330 NEXT I
  965. 62340 RETURN
  966. 62350 *SEARCH_DIR
  967. 62360 PATH_ALL$="*.*"+CHR$(0)
  968. 62370 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0)
  969. 62380 ROOT=0:FILE_SU=0
  970. 62390 IF A<>0 THEN RETURN ELSE FILE_SU=2
  971. 62400 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2
  972. 62410 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">" ELSE FILE_SU=1
  973. 62420 FOR I=FILE_SU TO 256
  974. 62430     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1)
  975. 62440     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUTD ELSE FILE_SU=I
  976. 62450     KAKUNO$=FILE_NAME$(I)
  977. 62460     IF ASC(KAKUNO$)=68 THEN FILE_NAME$(I)="1<"+MID$(KAKUNO$,2,12)+">" ELSE I=I-1
  978. 62470 *LOOPOUTD
  979. 62480 NEXT I
  980. 62490 RETURN
  981. 62500 *SEARCH_COM
  982. 62510 WCS$=STRING$(12,CHR$(0)):WCT$=FNFF$(WC$):MID$(WCT$,9,1)=" "
  983. 62520 FOR A=0 TO 11
  984. 62530  A$=MID$(WCT$,A+1,1)
  985. 62540  IF A<8 AND A$="*" THEN FOR B=A TO 7:WC(B)=0:NEXT:A=8:GOTO *WCGEN_NEXT
  986. 62550  IF A>8 AND A$="*" THEN FOR B=A TO 11:WC(B)=0:NEXT:A=12:GOTO *WCGEN_NEXT
  987. 62560  IF A$="?" THEN WC(A)=0:GOTO *WCGEN_NEXT
  988. 62570  WC(A)=1:MID$(WCS$,A+1,1)=A$
  989. 62580  *WCGEN_NEXT
  990. 62590 NEXT
  991. 62600 WCT$="":FOR A=1 TO KLEN(WCS$):A$=KMID$(WCS$,A,1):IF INSTR("abcdefghijklmnopqrstuvwxyz",A$)<>0 THEN A$=CHR$(ASC(A$)-32)
  992. 62610 WCT$=WCT$+A$:NEXT:SWAP WCT$,WCS$
  993. 62620 PATH_ALL$="*.*"+CHR$(0)
  994. 62630 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0)
  995. 62640 ROOT=0
  996. 62650 IF A<>0 THEN FILE_SU=0:RETURN
  997. 62660 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2
  998. 62670 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">":I=1 ELSE I=1:GOSUB *WC_CHK
  999. 62680 FOR I=I+1 TO 256
  1000. 62690     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1)
  1001. 62700     IF A<>0 THEN FILE_SU=I-1:I=300:GOTO *LOOPOUTC
  1002. 62710     IF ASC(FILE_NAME$(I))=68 THEN FILE_NAME$(I)="1<"+MID$(FILE_NAME$(I),2,12)+">" ELSE GOSUB *WC_CHK
  1003. 62720 *LOOPOUTC
  1004. 62730 NEXT I
  1005. 62740 IF I<280 THEN FILE_SU=256
  1006. 62750 RETURN
  1007. 62760 *WC_CHK
  1008. 62770  WCT$=FNFF$(MID$(FILE_NAME$(I),2,12))
  1009. 62780  FOR J=0 TO 11:IF WC(J)=0 THEN MID$(WCT$,J+1,1)=CHR$(0)
  1010. 62790  NEXT
  1011. 62800  IF WCT$<>WCS$ THEN I=I-1:RETURN
  1012. 62810  FILE_NAME$(I)="2 "+MID$(FILE_NAME$(I),2,12)+" "
  1013. 62820 RETURN
  1014. 62870 *SORT
  1015. 62880 I=FILE_SU\2
  1016. 62890 J=1:FLG=0
  1017. 62900 *SORT1
  1018. 62910 IF J+I>FILE_SU THEN IF FLG=1 THEN J=1:FLG=0 ELSE I=I\2:J=1:FLG=0:IF I=0 THEN *SCROLL_CALC
  1019. 62920 IF FILE_NAME$(J)>FILE_NAME$(J+I) THEN SWAP FILE_NAME$(J),FILE_NAME$(J+I):FLG=1
  1020. 62930 J=J+1
  1021. 62940 GOTO *SORT1
  1022. 62950 *SCROLL_CALC
  1023. 62960 F_S=FILE_SU-ROOT:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%8
  1024. 62970 IF F_S<10 THEN BOX_S!=1:BOX_RH=0:BOX_H=130:B_MAX=243:RETURN
  1025. 62980 BOX_S!=130/F_S
  1026. 62990 BOX_RH=BOX_S!*9:BOX_H=130-BOX_RH:B_MAX=113+BOX_H
  1027. 63000 RETURN
  1028. 63010 *HYOUJI
  1029. 63020 GOSUB *SCROLL_BAR:IF MOFF=1 THEN COLOR 1 ELSE COLOR 7
  1030. 63030 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
  1031. 63040 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN *HYOUJI_RET
  1032. 63050 FOR J=F_NUM+ROOT TO F_NUM_HYO
  1033. 63060     LOCATE FDX+5,FDY+5+J-(F_NUM+ROOT):IF LEFT$(FILE_NAME$(J),1)="1" THEN PRINT MID$(FILE_NAME$(J),2,14) ELSE PRINT " "+FNFF$(MID$(FILE_NAME$(J),3,12))+" "
  1034. 63070 NEXT J
  1035. 63080 *HYOUJI_RET
  1036. 63090 COLOR 7:RETURN
  1037. 63100 *HYOUJI_SPC
  1038. 63110 FOR J=0 TO 8
  1039. 63120     LOCATE FDX+5,FDY+5+J:PRINT SPC(14)
  1040. 63130 NEXT J
  1041. 63140 LOCATE FDX+6,FDY+15:PRINT SPC(12)
  1042. 63150 RETURN
  1043. 63160 *DRV_HYO
  1044. 63170 LOCATE FDX+11,FDY+2:PRINT AKCNV$(MID$(DRV_SET$,DRV_NO,1))
  1045. 63175 'I=ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A")
  1046. 63180 'LOCATE FDX+11,FDY+2:PRINT KNJ$(9025+I)
  1047. 63190 RETURN
  1048. 63200 *DISK_FREE
  1049. 63210 DFREE&=0
  1050. 63220 DFREE&=DSKF(ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A"))
  1051. 63230 LOCATE FDX+30,FDY+1:IF DFREE&<1024 THEN PRINT USING "#,###KB";DFREE& ELSE PRINT USING "###.#MB";DFREE&/1024 
  1052. 63240 RETURN
  1053. 63250 *接続ドライブ
  1054. 63260 DRV_SET$=""
  1055. 63270 J=0:A&=0
  1056. 63280 INFOR$=STRING$(200,0)
  1057. 63290 CALLM OFFSET&,7,VARPTR(INFOR$)
  1058. 63300 A&=PEEK(VARPTR(INFOR$),4)
  1059. 63310 FOR I&=&H30 TO &H4F STEP 2
  1060. 63320      IF PEEK(A&+I&)<>255 THEN DRV_SET$=DRV_SET$+CHR$(&H41+J)
  1061. 63330  J=J+1
  1062. 63340 NEXT
  1063. 63350 DRV_SET$=DRV_SET$+"Q"
  1064. 63360 DRV_SU=LEN(DRV_SET$)
  1065. 63370 RETURN
  1066. 63380 *PUT_FDMES
  1067. 63390 FDMT$=LEFT$(FDM$,68):IF LEN(FDMT$)=68 THEN IF KTYPE(FDM$,KLEN(FDMT$))=1 THEN FDMT$=LEFT$(FDM$,67)
  1068. 63400 LOCATE FDX+4,FDY+16:PRINT SPC(40):LOCATE FDX+4,FDY+17:PRINT SPC(40)
  1069. 63410 LOCATE FDX+4,FDY+16
  1070. 63420 WHILE LEN(FDMT$)>0
  1071. 63430  IF KTYPE(FDMT$,1)=1 AND POS(0)=FDX+37 THEN PRINT " ";
  1072. 63440  IF POS(0)>FDX+37 THEN LOCATE FDX+4,FDY+17:IF LEN(FDMT$)>34 THEN IF KTYPE(FDMT$,KLEN(FDMT$))=1 THEN FDMT$=KLEFT$(FDMT$,KLEN(FDMT$)-1) ELSE FDMT$=LEFT$(FDMT$,34)
  1073. 63450  PRINT KLEFT$(FDMT$,1);:IF LEN(FDMT$)<>0 THEN FDMT$=KRIGHT$(FDMT$,KLEN(FDMT$)-1)
  1074. 63460 WEND
  1075. 63470 COLOR 7,,,0
  1076. 63480 RETURN
  1077. 63490 *NOT_DRV
  1078. 63500 BEEP:M$="指定されたディスク装置が使用可能な状態になっていません"
  1079. 63510 COLOR 2,,,4
  1080. 63520 SWAP FDM$,M$:GOSUB *PUT_FDMES
  1081. 63530 WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND
  1082. 63540 SWAP FDM$,M$:GOSUB *PUT_FDMES
  1083. 63550 FILE_SU=0
  1084. 63560 ROOT=0
  1085. 63570 MOFF=1
  1086. 63580 RETURN
  1087. 63590 *エラー処理
  1088. 63600 IF ERR=72 THEN GOSUB *NOT_DRV
  1089. 63610 RESUME NEXT
  1090. 63620 *CLICK_AREA
  1091. 63630 DATA  41, 26,76 , 64 :'  ドライブ移動左ボタンの範囲
  1092. 63640 DATA  76, 26,116, 64 :'  ドライブ決定ボタンの範囲
  1093. 63650 DATA 116, 26,153, 64 :'  ドライブ移動右ボタンの範囲
  1094. 63660 DATA 172, 74,194, 92 :'   親ディレクトリ移動ボタンの範囲
  1095. 63670 DATA  38, 93,153,264 :'   ファイル一覧枠の範囲
  1096. 63680 DATA 172, 94,194,112 :'   ファイルアップボタンの範囲
  1097. 63690 DATA 172,245,194,264 :'   ファイルダウンボタンの範囲
  1098. 63700 DATA 172,282,209,304 :'   実行ボタンの範囲
  1099. 63710 DATA 220,282,257,304 :'   取消ボタンの範囲
  1100. 63720 DATA  38,283,153,302 :'   選択ファイル枠の範囲
  1101. 63730 DATA 172,112,194,245 :'   スクロールバーの範囲
  1102. 63740 DATA 198, 74,311,264 :'   ラジオボタンの範囲
  1103.